In VISUALIZATION VIBES project Study 2, participants completed an attitutde eliciation survey, asking questions about their attitude toward (5) stimulus images (data visualizations). Each participant was randomly assigned to one of 6 stimulus blocks, each containing 1 image from each of (4) pseudo-categories (ranging from most abstract to most figural). Each participant started by responding to questions for a single ‘common’ stimulus (that is thus super-powered as it was seen by all participants). Two participant recruitment pools were used: Prolific, with a smaller set of participants recruited from Tumblr (to replicate and compare survey results to Study 1 interviews with participants sourced from Tumblr).

This notebook contains code to replicate quantitative analysis of data from Study 2 reported in the CHI submission. Note that due to limited space, we were unable to report results for all stimulus blocks, and all possible analyses. A separate set of R notebooks are included in the supplementary materials that document analysis of the other blocks not reported here.

This notebook includes analysis and exploration of the full data set (i.e. data aggregated over all stimuli).

1 SETUP

We start by importing data files previously wrangled in 0_VIBES_S2_wrangling.Rmd.

1.1 Import Data

############## IMPORT REFERENCE FILES
ref_stimuli <- readRDS("data/input/REFERENCE/ref_stimuli.rds")
ref_surveys <- readRDS("data/input/REFERENCE/ref_surveys.rds")
ref_labels <- readRDS("data/input/REFERENCE/ref_labels.rds")
ref_labels_abs <- readRDS("data/input/REFERENCE/ref_labels_abs.rds")

############## SETUP Graph Labels
ref_stim_id <- levels(ref_stimuli$ID)
ref_cat_questions <- c("MAKER_ID","MAKER_AGE","MAKER_GENDER")
ref_free_response <- c("MAKER_DETAIL", "MAKER_EXPLAIN", "TOOL_DETAIL", "CHART_EXPLAIN")
ref_conf_questions <- c("MAKER_CONF", "AGE_CONF", "GENDER_CONF", "TOOL_CONF")
ref_sd_questions <- rownames(ref_labels)
ref_sd_questions_abs <- rownames(ref_labels_abs)
  

# ref_blocks <- c("block1", "block2", "block3", "block4", "block5", "block6")
ref_blocks <- c(1,2,3,4,5,6)
############## IMPORT DATA FILES
# df_data <- readRDS("data/output/df_data.rds") #1 row per participant — WIDE
df_participants <- readRDS("data/output/df_participants.rds") #1 row per participant — demographic
df_questions <- readRDS("data/output/df_questions.rds") #1 row per question — LONG
df_sd_questions_wide <- readRDS("data/output/df_sd_questions_wide.rds") # only sd questions WIDE


df_tools <- readRDS("data/output/df_tools.rds") #multiselect format for tools Question
df_actions <- readRDS("data/output/df_actions.rds") # multiselect format for action Question
# # df_graphs_full <- readRDS("data/output/df_graphs_full.rds") #includes free response data

df_graphs <- readRDS("data/output/df_graphs.rds") #only categorical and numeric questions
df_sd_questions_long <- readRDS("data/output/df_sd_questions_long.rds") # only sd questions LONG

### DATA FILES WITH (VARIABLE-WISE) Z-SCORED SEMANTIC DIFFERENTIAL QS 
df_graphs_z <- readRDS("data/output/df_graphs_z.rds") #only categorical and numeric questions
df_sd_questions_long_z <- readRDS("data/output/df_sd_questions_long_z.rds") # only sd questions LONG


### DATA FILES WITH ABSOLUTE VALUE SEMANTIC DIFFERENTIAL QS 
df_graphs_abs <- readRDS("data/output/df_graphs_abs.rds") #only categorical and numeric questions
df_sd_questions_long_abs <- readRDS("data/output/df_sd_questions_long_abs.rds") # only sd questions LONG

1.2 Set up Graphing

############## SETUP Colour Palettes
#https://www.r-bloggers.com/2022/06/custom-colour-palettes-for-ggplot2/

## list of color pallettes
my_colors = list(
  politics = c("#184aff","#5238bf", "#4f4a52" ,"#84649c", "#ff0000"),
  blackred = c("black","red"),
  greys = c("#707070","#999999","#C2C2C2"),
  greens = c("#ADC69D","#81A06D","#567E39","#2D5D16","#193E0A"),
  smallgreens = c("#ADC69D","#567E39","#193E0A"),
  olives = c("#CDCEA1","#B8B979","#A0A054","#78783F","#50502A","#35351C"),
  lightblues = c("#96C5D2","#61A2B2","#3C8093","#2C6378","#1F4A64"),
  darkblues = c("#7AAFE1","#3787D2","#2A73B7","#225E96","#1A4974","#133453"),
  reds = c("#D9B8BD","#CE98A2","#B17380","#954E5F","#78263E","#62151F"),
  traffic = c("#CE98A2","#81A06D","yellow"),
  questions = c("#B17380","#3787D2", "#567E39", "#EE897F"),
  tools= c("#D55662","#EE897F","#F5D0AD","#A0B79B","#499678","#2D363A"),
  encounter = c("#729B7D","#8E8E8E"),
  actions = c("#2A363B","#039876ff","#99b898ff","#fdcea8ff","#ff837bff","#e84a60ff"),
  platforms = c("#5D93EA","#FF70CD", "#3BD3F5", "#8B69B5","black"),
  amy_gradient =  c("#ac57aa", "#9e5fa4", "#90689f", "#827099", "#747894", "#66818e", "#578988", "#499183", "#3b997d", "#2da278", "#1faa72"),
  my_favourite_colours = c("#702963", "#637029",    "#296370")
                
)

## function for using palettes
my_palettes = function(name, n, all_palettes = my_colors, type = c("discrete","continuous"), direction = c("1","-1")) {
  palette = all_palettes[[name]]
  if (missing(n)) {
    n = length(palette)
  }
  type = match.arg(type)
  out = switch(type,
               continuous = grDevices::colorRampPalette(palette)(n),
               discrete = palette[1:n]
  )
  out = switch(direction,
               "1" = out,
               "-1" = palette[n:1])
  structure(out, name = name, class = "palette")
}
############## RETURNS SD STACKED AND COLORED BY BY X
## LOOP STYLE
multi_sd <- function (data, left, right, x, y, color) {

  # g <- ggplot(df, aes(y = .data[[x]], x = {{y}}, color = {{color}}))+
  g <- ggplot(data, aes(y = .data[[x]], x = .data[[y]], color = .data[[color]]))+
  geom_boxplot(width = 0.5) +
  geom_jitter(width = 0.1, alpha=0.5) +
    
  scale_y_continuous(limits=c(-1,101)) +
  labs(x="", y="") +
  coord_flip() +
  guides(
    y = guide_axis_manual(labels = left),
    y.sec = guide_axis_manual(labels = right)
  ) + theme_minimal()

  return(g)
}


############## RETURNS SINGLE SD 
## LOOP STYLE
single_sd <- function (data, left, right, x) {

  g <- ggplot(data, aes(y = {{x}}, x = ""))+
  geom_boxplot(width = 0.5) +
  geom_jitter(width = 0.1, alpha=0.5) +
  scale_y_continuous(limits=c(-1,101)) +
  labs(x="", y="") +
  coord_flip() +
  guides(
    y = guide_axis_manual(labels = left),
    y.sec = guide_axis_manual(labels = right)
  ) + theme_minimal()

  return(g)
}


######## RETURNS SINGLE SD
##  APPLY STYLE
plot_sd = function (data, column, type, mean, facet, facet_by, boxplot) {

  ggplot(data, aes(y = .data[[column]], x="")) +
    {if(boxplot) geom_boxplot(width = 0.5) } +
    geom_jitter(width = 0.1, alpha=0.2, {if(facet) aes(color=.data[[facet_by]])}) +
    {if(mean) stat_summary(fun="mean", geom="point", shape=20, size=5, color="blue", fill="blue")} +
    {if(mean) 
      stat_summary(fun="mean", geom="text", colour="blue",  fontface = "bold",
                 vjust=-1.25, hjust = 0.50, aes( label=round(..y.., digits=0)))
      } +
    
    {if(facet) facet_grid(.data[[facet_by]] ~ .)} +
    # scale_y_continuous(limits=c(-1,101)) +
    labs(x="", y="") +
    coord_flip()  +
    {if(type == "S")
      guides(
        y = guide_axis_manual(labels = ref_labels[column,"left"]),
        y.sec = guide_axis_manual(labels = ref_labels[column,"right"])
      )} +
    {if(type == "Q")
      guides(
        y = guide_axis_manual(labels = ref_labels[q,"left"]),
        y.sec = guide_axis_manual(labels = ref_labels[q,"right"])
      )} +
  theme_minimal()  +
     labs (
       caption = column
     ) + easy_remove_legend()
}

2 FULL SAMPLE ANALYSIS

As we argue in our manuscript, we understand that an individual’s response to a visualization (both inferences about data, as well as any other behaviours) will vary based on properties of: (1) the visualization, (2) the data, (3) the individual, and (4) the situational context. Thus, our survey is not designed to uncover consistencies in behaviour, but rather, explore the nature of variance in behaviour as a function of the individual and visualization.

(n = 318 ) survey respondents answered questions about some subset of the stimuli, (common stimulus B0-0 and 4 additional images defined as a block), yielding (o = 1590) stimulus-level observations.

2.1 SAMPLE

2.1.1 Sample Demographics

df <- df_participants

## FOR DESCRIPTIVES PARAGRAPH
# #PROLIFIC
df.p <- df %>% filter(Distribution == "PROLIFIC")
desc.gender.p <- table(df.p$D_gender) %>% prop.table()
names(desc.gender.p) <- levels(df.p$D_gender)
p_participants <- nrow(df.p)

# #TUMBLR
df.t <- df %>% filter(Distribution == "TUMBLR")
desc.gender.t <- table(df.t$D_gender) %>% prop.table()
names(desc.gender.t) <- levels(df.t$D_gender)
t_participants <- nrow(df.t)

For study 2, a total of 318 participants were recruited from US-located English speaking users of TUMBLR (n = 78) and PROLIFIC (n = 240).

240 individuals from PROLIFIC participated in Study 2, ( 54% Female, 42% Male, 3% Non-binary, 1% Other).

78 individuals from Tumblr participated in Study 2, ( 36% Female, 5% Male, 40% Non-binary, 19% Other). Note that a higher proportion of participants recruited from TUMBLR report identities other than cis-gender Female and cis-gender Male.

2.1.2 Study Response Time

df <- df_participants

## for descriptives paragraph
p.desc.duration <- psych::describe(df %>% filter(Distribution=="PROLIFIC") %>% pull(duration.min))
t.desc.duration <- psych::describe(df %>% filter(Distribution=="TUMBLR") %>% pull(duration.min))

PROLIFIC SAMPLE (n = 240 ) participant response times ranged from 13.97 to 216.18 minutes, with a mean response time of 42.49 minutes, SD = 21.15.

TUMBLR SAMPLE (n = 78 ) participant response times ranged from 10.88 to 227.57 minutes, with a mean response time of 51.93 minutes, SD = 35.47.

rm(df, df.p, df.t, p.desc.duration, t.desc.duration, desc.gender.p, desc.gender.t, p_participants, t_participants)
#full stimulus-level data
df_full <- df_graphs %>% 
  mutate(
    STUDY = "" #dummy variable for univariate visualizations
  )
# %>%
#   mutate(MAKER_ID = fct_rev(MAKER_ID))

2.2 CONFIDENCE

When asking participants to identify the type, age and gender of the maker of a visualization, we also asked participants to indicate their confidence in these choices.

Across all participants and all stimuli, are these (categorical) questions answered with the same degree of confidence?

Here we examine both the central tendency (mean) and shape of the distribution for each confidence variable.

df <- df_full %>% select(PID, Distribution, STIMULUS,MAKER_CONF, AGE_CONF, GENDER_CONF, TOOL_CONF) %>% 
  pivot_longer(
    cols = c(MAKER_CONF, AGE_CONF, GENDER_CONF, TOOL_CONF),
    names_to = "QUESTION",
    values_to = "CONFIDENCE"
  ) %>% 
  mutate(
    QUESTION = factor(QUESTION, levels=c("MAKER_CONF","AGE_CONF","GENDER_CONF","TOOL_CONF"  ) )
  )


## B
## CONFIDENCE ACROSS QUESTIONS (all stimuli, all Pps)
## BOXPLOT W/ JITTER
B <- df %>% ggplot(aes(x=QUESTION, y= CONFIDENCE)) + 
  geom_boxplot(width = 0.5) + 
  geom_jitter(alpha = 0.25, position=position_dodge2(width = 0.25)) + 
  ## MEAN
    stat_summary(fun=mean, geom="text", colour="blue",  fontface = "bold", size=3,
                 vjust=+0.5, hjust = -1.5, aes( label=round(..y.., digits=0)))+
    stat_summary(fun=mean, geom="point", size=2, color="blue", fill="blue") +
  theme_minimal() + 
  labs(title = "Confidence by Survey Question", caption = "(mean in blue)")


## R
## CONFIDENCE ACROSS QUESTIONS (all stimuli, all Pps)
## RIDGEPLOT W/ INTERVAL MEAN
R <- df %>% 
  ggplot(aes(x=CONFIDENCE, y=fct_rev(QUESTION), fill=fct_rev(QUESTION))) + 
    geom_density_ridges(scale = 0.65, alpha = 0.75, quantile_lines = TRUE) +
    scale_x_continuous(limits = c(0,100))+
    scale_fill_manual(values = my_palettes(name="questions", direction = "-1"), name = "",  guide = guide_legend(reverse = TRUE)) +   
    stat_pointinterval(side = "bottom", scale = 0.7, slab_linewidth = NA, point_interval = "mean_qi") +
  ## MEAN
    stat_summary(fun=mean, geom="text", colour="blue",  fontface = "bold", size=3,
                vjust=+2.5, hjust = 0.50, aes( label=round(..x.., digits=0)))+
    stat_summary(fun=mean, geom="point", size=2, color="blue", fill="blue") +
  theme_minimal() + 
  labs(title = "Confidence by Survey Question", y = "QUESTION", caption =" (mean in blue)") + 
  easy_remove_legend()

(B+R)
## Picking joint bandwidth of 4.54

INTERPRETATION Aggregated across all participants and all stimuli, the average confidence scores for each question (maker id, age, gender, tool id) are similar, with slightly lower confidence for the GENDER question. This tells us there is enough variance in response to each question for the measure to be meaningful, and so we will follow up by investigating confidence at the STIMULUS level.

2.3 MAKER ID

Participants were asked:

Who do you think is most likely responsible for having this image created?
options: (select one). The response is stored as MAKER_ID

  • business or corporation

  • journalist or news outlet

  • educational or academic institution

  • government or political organization

  • other organization

  • an individual]

Participants were also asked: Please rate your confidence in this choice. The response is stored as MAKER_CONF .

#FILTER DATASET
df <- df_full


## D
## MAKER IDENTIFICATION AGGREGATED (all)
## GGSTATSPLOT
##############################
#hack for consistent ordering of ggstats bar plot
dx <- df %>% mutate( MAKER_ID = fct_rev(MAKER_ID) )
S <-   ggbarstats( data = dx, x = MAKER_ID, y = STUDY,
                   legend.title = "MAKER ID") + 
    scale_fill_manual(values = my_palettes(name="reds", direction = "1")) +
    theme_minimal() +
    labs( title = "",  x = "", y="") + 
    theme(aspect.ratio = 1)
## Scale for fill is already present.
## Adding another scale for fill, which will replace the existing scale.
##############################


  
## H
## HALF EYE SLAB GGDIST
##############################
H <- df %>% 
  group_by(MAKER_ID) %>% 
  mutate(count = n(), m = mean(MAKER_CONF)) %>% 
  ggplot(aes(y = MAKER_CONF, x = fct_rev(MAKER_ID), fill = fct_rev(MAKER_ID))) + 
  stat_halfeye(scale=0.55, density="bounded", point_interval = "mean_qi", normalize= "all") +
  ## MEAN
  stat_summary(fun=mean, geom="text", colour="blue",  fontface = "bold", size = 2,
               vjust=2.5, hjust = .5, aes( label=round(..y.., digits=0)))+
  stat_summary(fun=mean, geom="point", shape=20, size=3, color="blue", fill="blue") +
  scale_fill_manual(values = my_palettes(name="reds", direction = "-1"), guide = guide_legend(reverse = TRUE)) +
  geom_text(aes(label= paste0("n=",count) ,  y = 5), color = "black",
            size = 3, nudge_x=0.35) + 
  labs(y="Maker ID Confidence", x="") + 
  theme_minimal() + 
  easy_remove_legend()+
  coord_flip() 
##############################
  

(p <- (S + H)) + plot_annotation(
  title = "Maker ID and Confidence",
  # subtitle = "the categories of MAKER ID were chosen in similar proportion, 
  # and both the mean (in blue) and shape of distribution of confidence scores is similar across values of Maker ID",
  caption = "(blue indicates mean)"
)

INTERPRETATION The distribution of maker types is remarkably consitent across levels of the MAKER_ID variable, with the exception of ‘organization’. Howerver, as 4 of the 6 categories are specific kinds of organizatations, this is not surprising. The believe this distribution is likely a function of the diversity of stimuli we selected. We will address this hypothesis in block-level analysis, asking whether their is variance in the distribution of MAKER_ID between stimuli. Notably, the confidence scores are similar (both in mean and shape of distribution) regardless of the MAKER_ID, indicating that in general, there is no particular maker identification for which participants have less confidence.

2.4 MAKER AGE

Participants were asked: Take a moment to imagine the person(s) responsible for creating the image. What generation are they most likely from?
options: (select one) The response was saved as MAKER_AGE

  • boomers (60+ years old)

  • Generation X (44-59 years old)

  • Millennials (28-43 years old)

  • Generation Z (12 - 27 years old]

Participants were asked: Please rate your confidence in this choice. The response is stored as AGE_CONF .

#FILTER DATASET
df <- df_full


## D
## MAKER IDENTIFICATION AGGREGATED (all)
## GGSTATSPLOT
##############################
#hack for consistent ordering of ggstats bar plot
dx <- df %>% mutate( MAKER_AGE = fct_rev(MAKER_AGE) )
S <-   ggbarstats( data = dx, x = MAKER_AGE, y = STUDY,
                   legend.title = "MAKER AGE") + 
    scale_fill_manual(values = my_palettes(name="lightblues", direction = "1")) +
    theme_minimal() +
    labs( title = "",  x = "", y="") + 
    theme(aspect.ratio = 1)
## Scale for fill is already present.
## Adding another scale for fill, which will replace the existing scale.
##############################


  
## H
## HALF EYE SLAB GGDIST
##############################
H <- df %>% 
  group_by(MAKER_AGE) %>% 
  mutate(count = n(), m = mean(AGE_CONF)) %>% 
  ggplot(aes(y = AGE_CONF, x = fct_rev(MAKER_AGE), fill = fct_rev(MAKER_AGE))) + 
  stat_halfeye(scale=0.55, density="bounded", point_interval = "mean_qi", normalize= "all") +
  ## MEAN
  stat_summary(fun=mean, geom="text", colour="blue",  fontface = "bold", size = 2,
               vjust=2.5, hjust = .5, aes( label=round(..y.., digits=0)))+
  stat_summary(fun=mean, geom="point", shape=20, size=3, color="blue", fill="blue") +
  scale_fill_manual(values = my_palettes(name="lightblues", direction = "-1"), guide = guide_legend(reverse = TRUE)) +
  geom_text(aes(label= paste0("n=",count) ,  y = 5), color = "black",
            size = 3, nudge_x=0.35) + 
  labs(y="Maker AGE Confidence", x="") + 
  theme_minimal() + 
  easy_remove_legend()+
  coord_flip() 
##############################


(p <- (S + H)) + plot_annotation(
  title = "Maker AGE and Confidence",
  # subtitle = "The value
  # distribution of confidence scores is similar across values of Maker AGE",
  caption = "(blue indicates mean)"
)

INTERPRETATION The distribution of maker ages is distributed as we would expect if participants are answering the question with some sense of the maker’s occupation in mind, thus answering with generations that are mostly likely of working age (gen X, millennial). As with MAKER_ID, confidence scores are similar (both in mean and shape of distribution) across all levels of MAKER_AGE, indicating that in general, there is no MAKER_AGE for which participants have less confidence.

2.5 MAKER GENDER

Participants were asked: Take a moment to imagine the person(s) responsible for creating the image. What gender do they most likely identify with?
options: [female / male / other ] (select one). Responses were stored as MAKER_GENDER.

Participants were asked: Please rate your confidence in this choice. The response is stored as GENDER_CONF .

#FILTER DATASET
df <- df_full


## D
## MAKER IDENTIFICATION AGGREGATED (all)
## GGSTATSPLOT
##############################
#hack for consistent ordering of ggstats bar plot
dx <- df %>% mutate( MAKER_AGE = fct_rev(MAKER_AGE) )
S <-   ggbarstats( data = dx, x = MAKER_GENDER, y = STUDY,
                   legend.title = "MAKER GENDER") + 
    scale_fill_manual(values = my_palettes(name="smallgreens", direction = "1")) +
    theme_minimal() +
    labs( title = "",  x = "", y="") + 
    theme(aspect.ratio = 1)
## Scale for fill is already present.
## Adding another scale for fill, which will replace the existing scale.
##############################

  
## H
## HALF EYE SLAB GGDIST
##############################
H <- df %>% 
  group_by(MAKER_GENDER) %>% 
  mutate(count = n(), m = mean(GENDER_CONF)) %>% 
  ggplot(aes(y = GENDER_CONF, x = MAKER_GENDER, fill = MAKER_GENDER)) + 
  stat_halfeye(scale=0.55, density="bounded", point_interval = "mean_qi", normalize= "all") +
  ## MEAN
  stat_summary(fun=mean, geom="text", colour="blue",  fontface = "bold", size = 2,
               vjust=2.5, hjust = .5, aes( label=round(..y.., digits=0)))+
  stat_summary(fun=mean, geom="point", shape=20, size=3, color="blue", fill="blue") +
  scale_fill_manual(values = my_palettes(name="greens", direction = "-1"), guide = guide_legend(reverse = TRUE)) +
  geom_text(aes(label= paste0("n=",count) ,  y = 5), color = "black",
            size = 3, nudge_x=0.35) + 
  labs(y="Maker GENDER Confidence", x="") + 
  theme_minimal() + 
  easy_remove_legend()+
  coord_flip() 
##############################

  

(p <- (S + H)) + plot_annotation(
  title = "Maker GENDER and Confidence",
  # subtitle = "The value
  # distribution of confidence scores is similar across values of Maker AGE",
  caption = "(blue indicates mean)"
)

INTERPRETATION: The distribution of maker genders is not evenly distributed between men and women as we might expect. We suspect it is most likely that the ‘male’ category serves as a default value for the maker gender, in the absence of any particular feature of stimulus that viewers interpret as strongly feminine. This hypothesis is grounded in the free response data, where respondents tend to explicitly describe gender in the presence of a design feature consistent with modern western stereotypes (such us pink indicating feminine, or aggressive indicating masculine).

2.6 TOOL ID

Participants were asked: What tools do you think were most likely used to create this image?
options: (select all that apply). The response was saved as variable TOOL_ID (multi-select)

  • basic graphic design software (e.g. Canva, or similar)

  • advanced graphic design software (e.g. Adobe Illustrator, Figma, or similar)

  • data visualization software (e.g. Tableau, PowerBI, or similar)

  • general purpose software (e.g. MS Word/Excel, Google Sheets, or similar)

  • programming language (e.g. R, python, javascript, or similar)

Participants were asked: Please rate your confidence in this choice. The response is stored as TOOL_CONF .

#FILTER DATASET
df <- df_tools %>% 
  mutate(
    STUDY = ""
  )


## D
## MAKER IDENTIFICATION AGGREGATED (all)
## GGSTATSPLOT
##############################
#hack for consistent ordering of ggstats bar plot
S <-   ggbarstats( data = df, x = TOOL_ID, y = STUDY,
                   legend.title = "TOOL ID") + 
    scale_fill_paletteer_d("awtools::a_palette", direction = 1)+
    theme_minimal() +
    labs( title = "",  x = "", y="") + 
    theme(aspect.ratio = 1)
## Scale for fill is already present.
## Adding another scale for fill, which will replace the existing scale.
##############################



## H
## HALF EYE SLAB GGDIST
##############################
H <-  df %>% 
  group_by(TOOL_ID) %>% 
  mutate(count = n(), m = mean(TOOL_CONF)) %>% 
  ggplot(aes(y = TOOL_CONF, x = TOOL_ID, fill = TOOL_ID)) + 
  stat_halfeye(scale=0.55, density="bounded", point_interval = "mean_qi", normalize= "all") +
  ## MEAN
  stat_summary(fun=mean, geom="text", colour="blue",  fontface = "bold", size = 2,
               vjust=2.5, hjust = .5, aes( label=round(..y.., digits=0)))+
  stat_summary(fun=mean, geom="point", shape=20, size=3, color="blue", fill="blue") +
  scale_fill_manual(values = my_palettes(name="tools", direction = "1"), guide = guide_legend(reverse = TRUE)) +
  geom_text(aes(label= paste0("n=",count) ,  y = 5), color = "black",
            size = 3, nudge_x=0.35) + 
  labs(y="Maker GENDER Confidence", x="") + 
  theme_minimal() + 
  easy_remove_legend()+
  coord_flip() 
##############################
  

(p <- (S + H)) + plot_annotation(
  title = "TOOL ID and Confidence",
  # subtitle = "The value
  # distribution of confidence scores is similar across values of Maker AGE",
  caption = "(blue indicates mean)"
)

H

INTERPRETATION We had no expectations with respect to the distribution of values in tool identification, but note that are roughly even across categories (exception of ‘unknown’ and ‘programming’), and the confidence scores are similar.

2.7 ENCOUNTER CHOICE

The first question each participant saw in each stimulus block was: As you’re scrolling through your feed, you see this image. What would you do?

options: keep scrolling, pause and look at the image. (select one) The response was saved as variable ENCOUNTER

## B
## ENCOUNTER  BY STIMULUS
## GGSTATSPLOT
df_full %>% 
  ggbarstats(  
            x = ENCOUNTER, y = STUDY,
            legend.title = "ENCOUNTER",
            results.subtitle = FALSE) + 
    scale_fill_manual(values = my_palettes(name="encounter", direction = "-1"))+
    theme_minimal() + 
    labs( title = "ENCOUNTER Choice ", subtitle = "", x = "")
## Scale for fill is already present.
## Adding another scale for fill, which will replace the existing scale.

INTERPRETATION In roughly 10% more trials (participant + stimulus), participants indicated they would likely engage with the image rather than scroll past it.

2.8 ACTION CHOICE

The last question participants were asked in each stimulus block was: Imagine you encounter the following image while scrolling. Which of the following are you most likely to do?

options: (select all that apply). The response was saved as variable CHART_ACTION

  • post a comment

  • share/repost

  • share/repost WITH comment

  • look up more information about the topic or source

  • unfollow/block the source

  • NOTHING—just keep scrolling

## B
## ACTION  BY STIMULUS
## GGSTATSPLOT
#hack for consistent ordering of ggstats bar plot
df_actions %>% mutate(
  CHART_ACTION = fct_rev(CHART_ACTION),
  STUDY="") %>% 
  ggbarstats( x = CHART_ACTION, y = STUDY,
            legend.title = "CHART ACTION",
            results.subtitle = FALSE) + 
    # scale_fill_paletteer_d("awtools::a_palette", direction = 1)+
    scale_fill_manual(values = my_palettes(name="actions", direction = "1"))+
    theme_minimal() + 
    labs( title = "ACTION Choice ", subtitle = "", x = "")
## Scale for fill is already present.
## Adding another scale for fill, which will replace the existing scale.

INTERPRETATION A high proportion of participants answered ‘nothing’ chart action, which is not surprising given the social media context. I am surprised to see such a high proportion answering that they would seek further information!

2.9 PLATFORM CHOICE

Before starting the experimental blocks, participants were asked: Please choose a social media platform to imagine you are engaging with during this study

options: (select one). The response was saved as variable PLATFORM

  • Twitter/X, Tumblr

  • LinkedIn

  • Instagram

  • Facebook

## B
## PLATFORM  BY STIMULUS
## GGSTATSPLOT
#hack for consistent ordering of ggstats bar plot
df_full %>% 
  ggbarstats(  
            x = PLATFORM, y = STUDY,
            legend.title = "PLATFORM",
            results.subtitle = FALSE) + 
    scale_fill_manual(values = my_palettes(name="platforms", direction = "-1"))+
    theme_minimal() + 
    labs( title = "PLATFORM Choice ", subtitle = "", x = "")
## Scale for fill is already present.
## Adding another scale for fill, which will replace the existing scale.

INTERPRETATION We had no expectations about the distribution of social media platform.

2.10 SEMANTIC DIFFERENTIALS

Participants were also asked to rate certain characteristics of the chart, or its maker, along a semantic differential scale, implemented in Qualtrics as a continuous slider ranging from 0 -> 100 with biploar adjectives at the end of each scale. The slider defaulted to the center point (50), and the interface displayed the numeric value of the slider position as a tooltip while the element had focus. Note that on both touch and mouse devices participants could interact with the survey element as a slider (i.e. click and and drag, or touch and drag) or as a visual analogue scale (i.e. click or tap on position along the scale).

2.10.1 Full Scales

The SD scores visualized here are in the same form as the participants’ response scale (slider from 0-100).

2.10.1.1 AGGREGATED

2.10.1.1.1 boxplot
  #### LIST OF BLOXPLOTS + JITTER #############################################################################

  # setup dataframe 
  df <- df_graphs 
  
  #subset data cols 
  cols <- df %>% select( all_of(ref_sd_questions))
  plots <- as.list(lapply(colnames(cols), plot_sd, data = df, type ="S", mean=TRUE, facet = FALSE, boxplot=TRUE))
  
  #aggregate q plots into one for stimulus 
  plot_master_questions <- plots[[1]] / plots[[2]] / plots[[3]] / plots[[4]] / plots[[5]] / plots[[6]] / plots[[7]] /
   plots[[8]] /plots[[9]] /plots[[10]] /plots[[11]] + 
   plot_annotation(
     title = "ALL STIMULI",
     subtitle =""
   )
  
if(graph_save == TRUE){  
  ggsave(plot = plot_master_questions, path="figs/level_aggregated/distributions", filename =paste0("combined_stimuli","_box.png"), units = c("in"), width = 10, height = 14  )
}

plot_master_questions

2.10.1.1.2 ggdist halfeye
  #### GGDIST PLOT#############################################################################
  
  # setup dataframe 
  df <- df_sd_questions_long %>% select(1:8, QUESTION, STIMULUS_CATEGORY, value) 
  d <- left_join( x = df, y = ref_labels, 
                  by = c("QUESTION" = "ref_sd_questions")) %>% 
        mutate(
     
               category=factor(category, levels=c("COMPETENCY","MAKER","CHART")),
          QUESTION = factor(QUESTION, levels=ref_sd_questions))

  # GGDIST HALFEYE (raincloud doesn't work b/c long tails)
  (g <-
      ggplot(d, aes(y = fct_rev(QUESTION), x = value, fill=category)) +
    stat_halfeye(scale=0.8, density="bounded", point_interval = "median_qi", normalize="xy") +
    
    ## MEDIAN
    stat_summary(fun=median, geom="text", fontface = "bold", size= 2.2,
                vjust=+2, hjust = 0.50, aes(label=round(..x.., digits=0)))+
    stat_summary(fun=median, geom="point", size=2) +
    scale_color_manual(values = my_palettes(name="greys", direction = "1"))+
    scale_fill_manual(values = my_palettes(name="greys", direction = "1"))+
    guides(
      y = guide_axis_manual(labels = rev(ref_labels$left), title = ""),
      y.sec = guide_axis_manual(labels = rev(ref_labels$right))
    ) +
  cowplot::draw_text(text = ref_sd_questions, x = 90, y= ref_sd_questions,size = 8, vjust=-2) +
  labs (title = "ALL STIMULI", y = "", caption = "(point is median)") +
  theme_minimal() + easy_remove_legend()
)

  if(graph_save == TRUE){ 
  ggsave(plot = g, path="figs/level_aggregated/distributions", filename =paste0("combined_stimuli","_ggdist.png"), units = c("in"), width = 10, height = 14  )
  }
  
g

2.10.1.1.3 density ridges
#### DENSITY RIDGES#############################################################################
  # setup dataframe 
  df <- df_sd_questions_long %>% select(1:8, QUESTION, value)  
  d <- left_join( x = df, y = ref_labels, 
                  by = c("QUESTION" = "ref_sd_questions")) %>% 
        mutate(
          category=factor(category, levels=c("COMPETENCY","MAKER","CHART")),
          QUESTION = factor(QUESTION, levels=ref_sd_questions))
  
  
(x <-
    ggplot(d, aes(x = value, y = fct_rev(QUESTION), fill = category)) +
    geom_density_ridges(scale = 0.75, quantile_lines = TRUE, alpha = 0.75, panel_scaling = TRUE) + 
    # scale_fill_manual(values = my_palettes(name="amy_gradient", direction = "1"))+ 
    scale_fill_manual(values = my_palettes(name="greys", direction = "1"))+ 
    ## MEDIAN
    stat_summary(fun=median, geom="text", fontface = "bold", size= 2.2,
                vjust=+2, hjust = 0.50, aes(label=round(..x.., digits=0)))+
    stat_summary(fun=median, geom="point", size=2) +
    # scale_x_continuous(limits = c(0,100))+
    guides(
      y = guide_axis_manual(labels = rev(ref_labels$left)),
      y.sec = guide_axis_manual(labels = rev(ref_labels$right))
    ) +
    labs (title = "ALL STIMULI", y = "", caption = "(point is median)") +
    cowplot::draw_text(text = ref_sd_questions, x = 100, y= ref_sd_questions,size = 8, vjust=-2, position=position_nudge(y=-.20))  + ##raw
    # cowplot::draw_text(text = ref_sd_questions, x = -4, y= ref_sd_questions,size = 10, vjust=-2) + ##z-score
    theme_minimal() + easy_remove_legend()
)
## Picking joint bandwidth of 4.51

if(graph_save == TRUE) {
    ggsave(plot = x, path="figs/level_aggregated/distributions", filename =paste0("combined_stimuli","_ridges.png"), units = c("in"), width = 10, height = 14  )
}
## Picking joint bandwidth of 4.51

2.10.1.2 BY STIMULUS CATEGORY

#### GROUPED DENSITY RIDGES#############################################################################
  # setup dataframe 
  df <- df_sd_questions_long %>% select(1:8, QUESTION, STIMULUS_CATEGORY, value)  
  d <- left_join( x = df, y = ref_labels, 
                  by = c("QUESTION" = "ref_sd_questions")) %>% 
        mutate(
          category=factor(category, levels=c("COMPETENCY","MAKER","CHART")),
          QUESTION = factor(QUESTION, levels=ref_sd_questions),
          STIMULUS_CATEGORY = factor(STIMULUS_CATEGORY, levels = c("A","B","C","D","F")))
  
  
(  c <-ggplot(d, aes(x = value, y = fct_rev(QUESTION), fill=STIMULUS_CATEGORY))+ 
    geom_density_ridges(scale = 0.75, alpha = 0.5, panel_scaling = TRUE) +
    ## MEDIAN
    stat_summary(fun=median, geom="text", fontface = "bold", size= 2.2,
                vjust=-0.5, hjust = 0.50, aes(label=round(..x.., digits=0)))+
    stat_summary(fun=median, geom="point", size=1) +
    facet_grid2(.~STIMULUS_CATEGORY)+
    # geom_density_ridges(scale = 1, quantile_lines = TRUE, alpha = 0.25) 
    guides(
      y = guide_axis_manual(labels = rev(ref_labels$left)),
      y.sec = guide_axis_manual(labels = rev(ref_labels$right))
    ) +
    labs(title = "by STIMULUS CATEGORY", y = "", caption = "(point is median)") +
    cowplot::draw_text(text = ref_sd_questions, x = 40, y= ref_sd_questions, size = 6, vjust=2) + ##raw
    # # cowplot::draw_text(text = ref_sd_questions, x = -4, y= ref_sd_questions,size = 10, vjust=-2) + ##z-score
    theme_minimal() + easy_remove_legend()
)
## Picking joint bandwidth of 5.16
## Picking joint bandwidth of 5.32
## Picking joint bandwidth of 7.21
## Picking joint bandwidth of 6.27
## Picking joint bandwidth of 6.14

if(graph_save){
    ggsave(plot = c, path="figs/level_aggregated/distributions", filename =paste0("combined_by_category","_ridges.png"), units = c("in"), width = 10, height = 14  )
}  
## Picking joint bandwidth of 5.16
## Picking joint bandwidth of 5.32
## Picking joint bandwidth of 7.21
## Picking joint bandwidth of 6.27
## Picking joint bandwidth of 6.14
rm(df, c,x,g,plot_master_questions)

2.10.2 Absolute Values

Here the scale of the semantic differential questions have been collapsed, such that 0 is the midpoint of the scale (indicating uncertainty, or not strongly indicating either of the labelled traits) and both 100 and 0 are 50 (indicating a strong signal toward either of the labelled traits).

2.10.2.1 AGGREGATED

2.10.2.1.1 boxplot
#################### ALL QUESTIONS across ALL STIMULUS #############################################################

  
  #### LIST OF BLOXPLOTS + JITTER #############################################################################

  # setup dataframe 
  df <- df_graphs_abs 
  
  #subset data cols 
  cols <- df %>% select( all_of(ref_sd_questions_abs))
  plots <- as.list(lapply(colnames(cols), plot_sd, data = df, type ="S", mean=TRUE, facet = FALSE, boxplot=TRUE))
  
  #aggregate q plots into one for stimulus 
  plot_master_questions <- plots[[1]] / plots[[2]] / plots[[3]] / plots[[4]] / plots[[5]] / plots[[6]] / plots[[7]] /
   plots[[8]] /plots[[9]] /plots[[10]] /plots[[11]] + 
   plot_annotation(
     title = "ALL STIMULI — SD (ABSOLUTE VALUE)",
     subtitle =""
   )
  
  if(graph_save == TRUE){
  ggsave(plot = plot_master_questions, path="figs/level_aggregated/distributions", filename =paste0("ABS_combined_stimuli","_box.png"), units = c("in"), width = 10, height = 14  )
  }
  
  plot_master_questions

2.10.2.1.2 ggdist halfeye
  #### GGDIST PLOT#############################################################################
  
  # setup dataframe 
  df <- df_sd_questions_long_abs %>% select(1:8, QUESTION, STIMULUS_CATEGORY, value) 
  d <- left_join( x = df, y = ref_labels_abs, 
                  by = c("QUESTION" = "ref_sd_questions_abs")) %>% 
        mutate(
          category=factor(category, levels=c("COMPETENCY","MAKER","CHART")),
          QUESTION = factor(QUESTION, levels=ref_sd_questions))

  # GGDIST HALFEYE (raincloud doesn't work b/c long tails)
(  g <- ggplot(d, aes(y = fct_rev(QUESTION), x = value, fill=category)) +
    stat_halfeye(scale=0.8, density="bounded", point_interval = "median_qi", normalize="xy") +
    scale_fill_manual(values = my_palettes(name="greys", direction = "1"))+
    ## MEDIAN
    stat_summary(fun=median, geom="text", fontface = "bold", size= 2.2,
                vjust=+2, hjust = 0.50, aes(label=round(..x.., digits=0)))+
    stat_summary(fun=median, geom="point", size=2) +
    guides(
      y = guide_axis_manual(labels = rev(ref_labels$left), title = ""),
      y.sec = guide_axis_manual(labels = rev(ref_labels$right))
    ) +
  cowplot::draw_text(text = ref_sd_questions, x = 45, y= ref_sd_questions_abs,size = 8, vjust=-2) +
  labs (title = "ALL STIMULI — SD (ABSOLUTE VALUE)", y = "", caption = "(point is median)") +
  theme_minimal() + easy_remove_legend()
) 

if(graph_save == TRUE){
  ggsave(plot = g, path="figs/level_aggregated/distributions", filename =paste0("ABS_combined_stimuli","_ggdist.png"), units = c("in"), width = 10, height = 14  )
}
2.10.2.1.3 density ridges
  #### DENSITY RIDGES#############################################################################
  # setup dataframe 
  df <- df_sd_questions_long_abs %>% select(1:8, QUESTION, value)  
  d <- left_join( x = df, y = ref_labels_abs, 
                  by = c("QUESTION" = "ref_sd_questions_abs")) %>% 
        mutate(
          category=factor(category, levels=c("COMPETENCY","MAKER","CHART")),
          QUESTION = factor(QUESTION, levels=ref_sd_questions))
  
  
(  x <-ggplot(d, aes(x = value, y = fct_rev(QUESTION), fill = category)) +
    geom_density_ridges(scale = 0.9,quantile_lines = TRUE, alpha = 0.75) + 
    # scale_fill_manual(values = my_palettes(name="amy_gradient", direction = "1"))+ 
    scale_fill_manual(values = my_palettes(name="greys", direction = "1"))+ 
      stat_summary(fun=median, geom="text", fontface = "bold", size= 2.2,
                vjust=+2, hjust = 0.50, aes(label=round(..x.., digits=0)))+
    stat_summary(fun=median, geom="point", size=2) +
    guides(
      y = guide_axis_manual(labels = rev(ref_labels$left)),
      y.sec = guide_axis_manual(labels = rev(ref_labels$right))
    ) +
    labs(title = "ALL STIMULI — SD (ABSOLUTE VALUE)", y = "", caption = "(point is median)") +
    cowplot::draw_text(text = ref_sd_questions, x = 45, y= ref_sd_questions_abs, size = 8, vjust=-2, position=position_nudge(y=-.20))  + ##raw
    theme_minimal() + easy_remove_legend()
)
## Picking joint bandwidth of 2.9

if(graph_save == TRUE){
    ggsave(plot = x, path="figs/level_aggregated/distributions", filename =paste0("ABS_combined_stimuli","_ridges.png"), units = c("in"), width = 10, height = 14  )
}
## Picking joint bandwidth of 2.9

2.10.2.2 BY STIMULUS CATEGORY

  #### GROUPED DENSITY RIDGES#############################################################################
  # setup dataframe 
  df <- df_sd_questions_long_abs %>% select(1:8, QUESTION, STIMULUS_CATEGORY, value)  
  d <- left_join( x = df, y = ref_labels_abs, 
                  by = c("QUESTION" = "ref_sd_questions_abs")) %>% 
        mutate(
          category=factor(category, levels=c("COMPETENCY","MAKER","CHART")),
          QUESTION = factor(QUESTION, levels=ref_sd_questions),
          STIMULUS_CATEGORY = factor(STIMULUS_CATEGORY, levels = c("A","B","C","D","F")))
  
  
(  c <-ggplot(d, aes(x = value, y = fct_rev(QUESTION), fill=STIMULUS_CATEGORY))+ 
    geom_density_ridges(scale = 0.75, alpha = 0.5, panel_scaling = TRUE) +
    facet_grid2(.~STIMULUS_CATEGORY)+
     ## MEDIAN
    stat_summary(fun=median, geom="text", fontface = "bold", size= 2.2,
                vjust=-0.5, hjust = 0.50, aes(label=round(..x.., digits=0)))+
    stat_summary(fun=median, geom="point", size=1) +
    # geom_density_ridges(scale = 1, quantile_lines = TRUE, alpha = 0.25) 
    guides(
      y = guide_axis_manual(labels = rev(ref_labels_abs$left)),
      y.sec = guide_axis_manual(labels = rev(ref_labels_abs$right))
    ) +
    labs(title = "by STIMULUS CATEGORY (absolute value)", y = "") +
    cowplot::draw_text(text = ref_sd_questions_abs, x = 20, y= ref_sd_questions_abs, size = 6, vjust=2) + ##raw
    theme_minimal() + easy_remove_legend()
)
## Picking joint bandwidth of 3.78
## Picking joint bandwidth of 3.72
## Picking joint bandwidth of 4.28
## Picking joint bandwidth of 3.97
## Picking joint bandwidth of 3.84

if(graph_save == TRUE){
    ggplot2::ggsave(plot = c, path="figs/level_aggregated/distributions", filename =paste0("ABS_combined_by_category","_ridges.png"), units = c("in"), width = 10, height = 14  )
}
## Picking joint bandwidth of 3.78
## Picking joint bandwidth of 3.72
## Picking joint bandwidth of 4.28
## Picking joint bandwidth of 3.97
## Picking joint bandwidth of 3.84
rm(df, c,x,g,plot_master_questions)

2.11 CORRELATIONS

2.11.1 correlation matrices — semantic differential

df <- df_graphs %>% select(
          MAKER_DESIGN, MAKER_DATA, 
          MAKER_POLITIC, MAKER_ARGUE,
          MAKER_SELF, MAKER_ALIGN, MAKER_TRUST, 
          CHART_TRUST, CHART_INTENT, CHART_LIKE, CHART_BEAUTY, 
          PID)

print("FULL CORRELATION NO RANDOM EFFECT")
## [1] "FULL CORRELATION NO RANDOM EFFECT"
## CALCULATE full correlations with no random effects
c <- df %>%  correlation(partial=FALSE, include_factors=FALSE)
(s <- c %>% summary(redundant = FALSE))
## # Correlation Matrix (pearson-method)
## 
## Parameter     | CHART_BEAUTY | CHART_LIKE | CHART_INTENT | CHART_TRUST | MAKER_TRUST | MAKER_ALIGN | MAKER_SELF | MAKER_ARGUE | MAKER_POLITIC | MAKER_DATA
## ----------------------------------------------------------------------------------------------------------------------------------------------------------
## MAKER_DESIGN  |     -0.40*** |   -0.34*** |        -0.03 |    -0.19*** |    -0.16*** |     -0.09** |     0.09** |       -0.02 |          0.06 |    0.39***
## MAKER_DATA    |     -0.20*** |   -0.25*** |      0.32*** |    -0.39*** |    -0.35*** |    -0.15*** |    0.11*** |    -0.12*** |          0.02 |           
## MAKER_POLITIC |     -0.17*** |   -0.22*** |      0.11*** |    -0.20*** |    -0.32*** |    -0.47*** |    0.50*** |    -0.31*** |               |           
## MAKER_ARGUE   |      0.25*** |    0.30*** |     -0.31*** |     0.40*** |     0.49*** |     0.40*** |   -0.47*** |             |               |           
## MAKER_SELF    |     -0.34*** |   -0.42*** |      0.30*** |    -0.46*** |    -0.58*** |    -0.67*** |            |             |               |           
## MAKER_ALIGN   |      0.38*** |    0.47*** |     -0.27*** |     0.50*** |     0.62*** |             |            |             |               |           
## MAKER_TRUST   |      0.36*** |    0.49*** |     -0.43*** |     0.71*** |             |             |            |             |               |           
## CHART_TRUST   |      0.48*** |    0.60*** |     -0.48*** |             |             |             |            |             |               |           
## CHART_INTENT  |     -0.11*** |   -0.20*** |              |             |             |             |            |             |               |           
## CHART_LIKE    |      0.83*** |            |              |             |             |             |            |             |               |           
## 
## p-value adjustment method: Holm (1979)
plot(s, show_data="point") + labs(title = "Correlation Matrix",
               subtitle="(full correlation; pearson method; Holm p-value adjustment)") + theme_minimal()

print("PARTIAL CORRELATION WITH PID AS RANDOM EFFECT")
## [1] "PARTIAL CORRELATION WITH PID AS RANDOM EFFECT"
#CALCULATE partial correlations with PID as random effect
## (this isolates correlation pairwise factoring out other variables)
c <- df %>% correlation(partial=TRUE,multilevel = TRUE)
(s <- c %>% summary(redundant = FALSE ))
## # Correlation Matrix (pearson-method)
## 
## Parameter     | CHART_BEAUTY | CHART_LIKE | CHART_INTENT | CHART_TRUST | MAKER_TRUST | MAKER_ALIGN | MAKER_SELF | MAKER_ARGUE | MAKER_POLITIC | MAKER_DATA
## ----------------------------------------------------------------------------------------------------------------------------------------------------------
## MAKER_DESIGN  |     -0.26*** |   8.55e-03 |     -0.16*** |        0.04 |       -0.04 |        0.07 |       0.01 |       0.08* |          0.04 |    0.35***
## MAKER_DATA    |        0.08* |      -0.04 |      0.20*** |    -0.15*** |    -0.13*** |    3.78e-03 |   -0.13*** |        0.01 |         -0.06 |           
## MAKER_POLITIC |         0.02 |  -6.67e-03 |        -0.06 |        0.06 |       -0.05 |    -0.23*** |    0.28*** |    -0.11*** |               |           
## MAKER_ARGUE   |         0.07 |      -0.03 |     -0.11*** |        0.03 |     0.16*** |    7.90e-03 |   -0.17*** |             |               |           
## MAKER_SELF    |        -0.03 |      -0.04 |         0.07 |   -2.17e-03 |    -0.16*** |    -0.36*** |            |             |               |           
## MAKER_ALIGN   |     3.74e-03 |     0.10** |         0.04 |        0.04 |     0.25*** |             |            |             |               |           
## MAKER_TRUST   |       -0.08* |       0.05 |      -0.10** |     0.39*** |             |             |            |             |               |           
## CHART_TRUST   |         0.04 |    0.23*** |     -0.27*** |             |             |             |            |             |               |           
## CHART_INTENT  |         0.05 |       0.03 |              |             |             |             |            |             |               |           
## CHART_LIKE    |      0.74*** |            |              |             |             |             |            |             |               |           
## 
## p-value adjustment method: Holm (1979)
###### VIS WITH CORRELATION PACKAGE
#SEE [correlation] PLOT
g <- plot(s, show_data = "point",   show_text = "label",
     stars=TRUE, show_legend=FALSE,
     show_statistic = FALSE, show_ci = FALSE) + 
     theme_minimal()+
     labs(title = "Correlation Matrix — SD Questions", 
          subtitle="(partial correlation; pearson method; Holm p-value adjustment; participant as random effect)")
     # text = list(fontface = "italic")
g

ggsave(g, scale =1, filename = "figs/level_aggregated/heatmaps/partial_correlation_all.png", width = 14, height = 6, dpi = 320, limitsize = FALSE)

#PLOT GAUSSIAN GRAPH MODEL
# plot(c)


###### VIS WITH CORRPLOT <- -- customizable but can't save to file ARGH

## GET THE MATRIX
m <- as.matrix(c)


## JUST CIRCLES
corrplot(m, method = 'circle', type = 'lower',
         order = 'original', diag = FALSE, addCoef.col = "#7A7A7A",
         tl.col = "black")

These plots depict the PARTIAL CORRELATION pairwise between variables (partial correlation factors out influence of other variables), with participant ID as a random effect. The resulting values are pearson moment-correlation coefficients ranging of -1 (direct negative) to +1 direct positive correlation. These correlations are calculated on the full scale semantic differential questions (i.e. with the 0 - 100 range, where 1 and 100 are end points and 50 is the central point)

2.11.2 correlation matrices — semantic differential — absolute values

df <- df_graphs_abs %>% select(
          MAKER_DESIGN, MAKER_DATA, 
          MAKER_POLITIC, MAKER_ARGUE,
          MAKER_SELF, MAKER_ALIGN, MAKER_TRUST, 
          CHART_TRUST, CHART_INTENT, CHART_LIKE, CHART_BEAUTY, 
          PID)

print("FULL CORRELATION NO RANDOM EFFECT")
## [1] "FULL CORRELATION NO RANDOM EFFECT"
## CALCULATE full correlations with no random effects
c <- df %>%  correlation(partial=FALSE, include_factors=FALSE)
(s <- c %>% summary(redundant = FALSE))
## # Correlation Matrix (pearson-method)
## 
## Parameter     | CHART_BEAUTY | CHART_LIKE | CHART_INTENT | CHART_TRUST | MAKER_TRUST | MAKER_ALIGN | MAKER_SELF | MAKER_ARGUE | MAKER_POLITIC | MAKER_DATA
## ----------------------------------------------------------------------------------------------------------------------------------------------------------
## MAKER_DESIGN  |      0.24*** |    0.25*** |      0.13*** |     0.19*** |     0.16*** |     0.13*** |    0.15*** |     0.17*** |       0.11*** |    0.40***
## MAKER_DATA    |      0.18*** |    0.19*** |      0.27*** |     0.25*** |     0.20*** |     0.10*** |    0.15*** |     0.18*** |          0.04 |           
## MAKER_POLITIC |      0.14*** |    0.19*** |       0.08** |     0.24*** |     0.30*** |     0.58*** |    0.52*** |     0.44*** |               |           
## MAKER_ARGUE   |      0.15*** |    0.19*** |      0.23*** |     0.32*** |     0.44*** |     0.48*** |    0.54*** |             |               |           
## MAKER_SELF    |      0.18*** |    0.24*** |      0.20*** |     0.32*** |     0.49*** |     0.63*** |            |             |               |           
## MAKER_ALIGN   |      0.21*** |    0.28*** |      0.20*** |     0.39*** |     0.52*** |             |            |             |               |           
## MAKER_TRUST   |      0.15*** |    0.24*** |      0.29*** |     0.58*** |             |             |            |             |               |           
## CHART_TRUST   |      0.34*** |    0.45*** |      0.37*** |             |             |             |            |             |               |           
## CHART_INTENT  |      0.19*** |    0.21*** |              |             |             |             |            |             |               |           
## CHART_LIKE    |      0.68*** |            |              |             |             |             |            |             |               |           
## 
## p-value adjustment method: Holm (1979)
plot(s, show_data="point") + labs(title = "Correlation Matrix",
               subtitle="(full correlation; pearson method; Holm p-value adjustment)") + theme_minimal()

print("PARTIAL CORRELATION WITH PID AS RANDOM EFFECT")
## [1] "PARTIAL CORRELATION WITH PID AS RANDOM EFFECT"
#CALCULATE partial correlations with PID as random effect
## (this isolates correlation pairwise factoring out other variables)
c <- df %>% correlation(partial=TRUE, multilevel = TRUE)
(s <- c %>% summary(redundant = FALSE ))
## # Correlation Matrix (pearson-method)
## 
## Parameter     | CHART_BEAUTY | CHART_LIKE | CHART_INTENT | CHART_TRUST | MAKER_TRUST | MAKER_ALIGN | MAKER_SELF | MAKER_ARGUE | MAKER_POLITIC | MAKER_DATA
## ----------------------------------------------------------------------------------------------------------------------------------------------------------
## MAKER_DESIGN  |         0.08 |       0.07 |        -0.06 |   -2.84e-03 |        0.02 |       -0.02 |       0.03 |        0.03 |          0.03 |    0.31***
## MAKER_DATA    |         0.02 |  -1.43e-03 |      0.15*** |        0.07 |        0.05 |       -0.07 |       0.03 |        0.05 |         -0.04 |           
## MAKER_POLITIC |        -0.02 |       0.03 |        -0.07 |        0.01 |       -0.08 |     0.33*** |    0.21*** |     0.19*** |               |           
## MAKER_ARGUE   |         0.03 |      -0.02 |         0.06 |        0.03 |     0.13*** |        0.07 |    0.22*** |             |               |           
## MAKER_SELF    |    -9.25e-03 |       0.04 |         0.01 |       -0.07 |     0.16*** |     0.32*** |            |             |               |           
## MAKER_ALIGN   |         0.02 |       0.06 |         0.03 |        0.05 |     0.22*** |             |            |             |               |           
## MAKER_TRUST   |       -0.08* |      -0.02 |         0.07 |     0.39*** |             |             |            |             |               |           
## CHART_TRUST   |         0.07 |    0.22*** |      0.20*** |             |             |             |            |             |               |           
## CHART_INTENT  |    -9.03e-03 |   5.23e-03 |              |             |             |             |            |             |               |           
## CHART_LIKE    |      0.61*** |            |              |             |             |             |            |             |               |           
## 
## p-value adjustment method: Holm (1979)
###### VIS WITH CORRELATION PACKAGE
#SEE [correlation] PLOT
g <- plot(s, show_data = "point",   show_text = "label",
     stars=TRUE, show_legend=FALSE,
     show_statistic = FALSE, show_ci = FALSE) + 
     theme_minimal()+
     labs(title = "Correlation Matrix — SD Questions — absolute values", 
          subtitle="(partial correlation; pearson method; Holm p-value adjustment; participant as random effect)")
     # text = list(fontface = "italic")
g

ggsave(g, scale =1, filename = "figs/level_aggregated/heatmaps/partial_correlation_abs.png", width = 14, height = 6, dpi = 320, limitsize = FALSE)

#PLOT GAUSSIAN GRAPH MODEL
# plot(c)


###### VIS WITH CORRPLOT <- -- customizable but can't save to file ARGH

## GET THE MATRIX
m <- as.matrix(c)


## JUST CIRCLES
corrplot(m, method = 'circle', type = 'lower',
         order = 'original', diag = FALSE, addCoef.col = "#7A7A7A",
         tl.col = "black")

These plots depict the PARTIAL CORRELATION pairwise between variables (partial correlation factors out influence of other variables), with participant ID as a random effect. The resulting values are pearson moment-correlation coefficients ranging of -1 (direct negative) to +1 direct positive correlation. These correlations are calculated on the ABSOLUTE VALUE of the semantic differential questions (i.e. with the full scale folded in half, such that 50 now becomes 0, and the extrememe values (0, 100) become 50). The absolute value scale allows us to collapse for weak (near zero) vs. strong (near 50) signal in each variable.

2.11.3 correlation matrices — by category levels

Here we explore the distribution of each SD variable (e.g. MAKER TRUST) by the different values of each categorical variable (e.g. MAKER ID). Patterns of interest are noted, which we explore further in the section exploratory questions.

2.11.3.0.1 MAKER ID X SD
df <- df_graphs %>% select(MAKER_DESIGN, MAKER_DATA, 
                           MAKER_POLITIC, MAKER_ARGUE, MAKER_SELF, MAKER_ALIGN, MAKER_TRUST, 
                           CHART_TRUST, CHART_INTENT, CHART_LIKE, CHART_BEAUTY, 
                           PID, STIMULUS, BLOCK, STIMULUS_CATEGORY, 
                           MAKER_ID, MAKER_AGE, MAKER_GENDER)

## CORRELATION MATRIX SPLIT BY MAKER ID  
(x <-   ggscatmat(df, columns = 1:11, color = "MAKER_ID", alpha = 0.8) + 
    scale_color_manual(values = my_palettes(name="reds", direction = "1"), name = "",  guide = guide_legend(reverse = FALSE)) +   
    theme_minimal()
)

if(graph_save){
ggsave(plot = x, path="figs/level_aggregated/pairplots", filename =paste0("maker_id_corr_sd.png"), units = c("in"), width = 14, height = 10 )
}

x

Interesting patterns to explore further

  • When participants identify the maker as an INDIVIDUAL, the following variables show a different pattern than the other identifications: MAKER_DESIGN, MAKER_DATA, CHART INTENT
  • interesting bimodal distribution on CHART INTENT for most identifications, except individuals and organizations
2.11.3.0.2 MAKER ID X SD (abs)
df <- df_graphs_abs %>% select(MAKER_DESIGN, MAKER_DATA, 
                           MAKER_POLITIC, MAKER_ARGUE, MAKER_SELF, MAKER_ALIGN, MAKER_TRUST, 
                           CHART_TRUST, CHART_INTENT, CHART_LIKE, CHART_BEAUTY, 
                           PID, STIMULUS, BLOCK, STIMULUS_CATEGORY, 
                           MAKER_ID, MAKER_AGE, MAKER_GENDER)

## CORRELATION MATRIX SPLIT BY MAKER ID  
(x <-   ggscatmat(df, columns = 1:11, color = "MAKER_ID", alpha = 0.8) + 
    scale_color_manual(values = my_palettes(name="reds", direction = "1"), name = "",  guide = guide_legend(reverse = FALSE)) +   
    theme_minimal())

if(graph_save){
ggsave(plot = x, path="figs/level_aggregated/pairplots", filename =paste0("maker_id_corr_abs.png"), units = c("in"), width = 14, height = 10 )
}
x

2.11.3.0.3 MAKER AGE X SD
  df <- df_graphs %>% select(MAKER_DESIGN, MAKER_DATA, 
                           MAKER_POLITIC, MAKER_ARGUE, MAKER_SELF, MAKER_ALIGN, MAKER_TRUST, 
                           CHART_TRUST, CHART_INTENT, CHART_LIKE, CHART_BEAUTY, 
                           PID, STIMULUS, BLOCK, STIMULUS_CATEGORY, 
                           MAKER_ID, MAKER_AGE, MAKER_GENDER)
  
  ## CORRELATION MATRIX SPLIT BY MAKER AGE  
  (x <-   ggscatmat(df, columns = 1:11, color = "MAKER_AGE", alpha = 0.8) + 
    scale_color_manual(values = my_palettes(name="lightblues", direction = "1"), name = "",  guide = guide_legend(reverse = TRUE)) +   
    theme_minimal())

if(graph_save){    
  ggsave(plot = x, path="figs/level_aggregated/pairplots", filename =paste0("maker_age_corr_sd.png"), units = c("in"), width = 14, height = 10 )
}
x  

Interesting patterns to explore further

  • maker_design, chart_like, chart_beauty for BOOMER vs. others
  • maker_data for gen Z vs others
2.11.3.0.4 MAKER AGE X SD (abs)
  df <- df_graphs_abs %>% select(MAKER_DESIGN, MAKER_DATA, 
                           MAKER_POLITIC, MAKER_ARGUE, MAKER_SELF, MAKER_ALIGN, MAKER_TRUST, 
                           CHART_TRUST, CHART_INTENT, CHART_LIKE, CHART_BEAUTY, 
                           PID, STIMULUS, BLOCK, STIMULUS_CATEGORY, 
                           MAKER_ID, MAKER_AGE, MAKER_GENDER)

  ## CORRELATION MATRIX SPLIT BY MAKER AGE  
  (x <-   ggscatmat(df, columns = 1:11, color = "MAKER_AGE", alpha = 0.8) + 
    scale_color_manual(values = my_palettes(name="lightblues", direction = "1"), name = "",  guide = guide_legend(reverse = TRUE)) +   
    theme_minimal())

if(graph_save){
  ggsave(plot = x, path="figs/level_aggregated/pairplots", filename =paste0("maker_age_corr_abs.png"), units = c("in"), width = 14, height = 10 )
}
x

2.11.3.0.5 MAKER GENDER X SD
  df <- df_graphs %>% select(MAKER_DESIGN, MAKER_DATA, 
                           MAKER_POLITIC, MAKER_ARGUE, MAKER_SELF, MAKER_ALIGN, MAKER_TRUST, 
                           CHART_TRUST, CHART_INTENT, CHART_LIKE, CHART_BEAUTY, 
                           PID, STIMULUS, BLOCK, STIMULUS_CATEGORY, 
                           MAKER_ID, MAKER_AGE, MAKER_GENDER)
  
  ## CORRELATION MATRIX SPLIT BY MAKER GENDER  
  (x <-   ggscatmat(df, columns = 1:11, color = "MAKER_GENDER", alpha = 0.8) + 
    scale_color_manual(values = my_palettes(name="smallgreens", direction = "1"), name = "",  guide = guide_legend(reverse = TRUE)) +   
    theme_minimal() )

    if(graph_save){
  ggsave(plot = x, path="figs/level_aggregated/pairplots", filename =paste0("maker_gender_corr_sd.png"), units = c("in"), width = 14, height = 10 )
  }
  x

Interesting patterns to explore further - maker-data for FEMALE

2.11.3.0.6 MAKER GENDER X SD (abs)
  df <- df_graphs_abs %>% select(MAKER_DESIGN, MAKER_DATA, 
                           MAKER_POLITIC, MAKER_ARGUE, MAKER_SELF, MAKER_ALIGN, MAKER_TRUST, 
                           CHART_TRUST, CHART_INTENT, CHART_LIKE, CHART_BEAUTY, 
                           PID, STIMULUS, BLOCK, STIMULUS_CATEGORY, 
                           MAKER_ID, MAKER_AGE, MAKER_GENDER)

  
  ## CORRELATION MATRIX SPLIT BY MAKER GENDER  
  (x <-   ggscatmat(df, columns = 1:11, color = "MAKER_GENDER", alpha = 0.8) + 
    scale_color_manual(values = my_palettes(name="smallgreens", direction = "1"), name = "",  guide = guide_legend(reverse = TRUE)) +   
    theme_minimal() )

if(graph_save){
  ggsave(plot = x, path="figs/level_aggregated/pairplots", filename =paste0("maker_gender_corr_abs.png"), units = c("in"), width = 14, height = 10 )
}
  x

2.11.3.0.7 TOOL ID X SD
df <- df_tools %>% select(MAKER_DESIGN, MAKER_DATA, 
                           MAKER_POLITIC, MAKER_ARGUE, MAKER_SELF, MAKER_ALIGN, MAKER_TRUST, 
                           CHART_TRUST, CHART_INTENT, CHART_LIKE, CHART_BEAUTY, 
                    PID, STIMULUS, BLOCK, STIMULUS_CATEGORY, 
                    TOOL_ID) 
  
  ## CORRELATION MATRIX SPLIT BY TOOL ID
 (x <-  ggscatmat(df, columns = 1:11, color = "TOOL_ID", alpha = 0.8) + 
    scale_color_manual(values = my_palettes(name="tools", direction = "1"), name = "",  guide = guide_legend(reverse = TRUE)) +
    theme_minimal() )

  if(graph_save){
  ggsave(plot = x, path="figs/level_aggregated/pairplots", filename =paste0("tool_id_corr_sd.png"), units = c("in"), width = 14, height = 10 )
  }    
  x

Interesting patterns to explore further - maker data for design-basic, interesting pattern - look closer at chart beauty - interesting pattern across values on chart intent

2.11.3.0.8 ENCOUNTER X SD
df <- df_graphs %>% select(MAKER_DESIGN, MAKER_DATA, 
                           MAKER_POLITIC, MAKER_ARGUE, MAKER_SELF, MAKER_ALIGN, MAKER_TRUST, 
                           CHART_TRUST, CHART_INTENT, CHART_LIKE, CHART_BEAUTY, 
                    PID, STIMULUS, BLOCK, STIMULUS_CATEGORY, 
                    ENCOUNTER) %>% 
    mutate(ENCOUNTER = fct_rev(ENCOUNTER))

## CORRELATION MATRIX SPLIT BY ENCOUNTER
(x <-   ggscatmat(df, columns = 1:11, color = "ENCOUNTER", alpha = 0.8) + 
    scale_color_manual(values = my_palettes(name="encounter", direction = "1"))+
    theme_minimal())

if(graph_save){
  ggsave(plot = x, path="figs/level_aggregated/pairplots", filename =paste0("encounter_corr_sd.png"), units = c("in"), width = 14, height = 10 )
}
  x

Interesting patterns to explore further — no difference at ALL in maker data - interesting! - chart beauty very diff - chart intent intersting bimodal

2.11.3.0.9 ENCOUNTER X SD (abs)
df <- df_graphs_abs %>% select(MAKER_DESIGN, MAKER_DATA, 
                           MAKER_POLITIC, MAKER_ARGUE, MAKER_SELF, MAKER_ALIGN, MAKER_TRUST, 
                           CHART_TRUST, CHART_INTENT, CHART_LIKE, CHART_BEAUTY, 
                    PID, STIMULUS, BLOCK, STIMULUS_CATEGORY, 
                    ENCOUNTER) %>% 
    mutate(ENCOUNTER = fct_rev(ENCOUNTER))

## CORRELATION MATRIX SPLIT BY ENCOUNTER
(x <-   ggscatmat(df, columns = 1:11, color = "ENCOUNTER", alpha = 0.8) + 
    scale_color_manual(values = my_palettes(name="encounter", direction = "1"))+
    theme_minimal())

if(graph_save){
  ggsave(plot = x, path="figs/level_aggregated/pairplots", filename =paste0("encounter_corr_abs.png"), units = c("in"), width = 14, height = 10 )
}
  x

2.11.3.0.10 CHART ACTION X SD
df <- df_actions %>% select(MAKER_DESIGN, MAKER_DATA, 
                           MAKER_POLITIC, MAKER_ARGUE, MAKER_SELF, MAKER_ALIGN, MAKER_TRUST, 
                           CHART_TRUST, CHART_INTENT, CHART_LIKE, CHART_BEAUTY, 
                    PID, STIMULUS, BLOCK, STIMULUS_CATEGORY, 
                    CHART_ACTION) 
  
  ## CORRELATION MATRIX SPLIT BY CHART ACTION
(x <- ggscatmat(df, columns = 1:11, color = "CHART_ACTION", alpha = 0.2) + 
    scale_color_manual(values = my_palettes(name="actions", direction = "1"), name = "",  guide = guide_legend(reverse = TRUE)) +
    theme_minimal() )

if(graph_save){
ggsave(plot = x, path="figs/level_aggregated/pairplots", filename =paste0("chart_action_corr_sd.png"), units = c("in"), width = 14, height = 10  )
}
x

Interesting patterns to explore further - unfollow/block across all!

2.12 EXPLORATORY QUESTIONS

  • When participants identify the maker as an INDIVIDUAL, the following variables show a different pattern than the other identifications: MAKER_DESIGN, MAKER_DATA, CHART INTENT
  • interesting bimodal distribution on CHART INTENT for most identifications, except individuals and organizations

2.12.1 MAKER ID & Maker DATA COMPETENCY

df <- df_graphs 

## Does MAKER_DATA  depend on MAKER ID?
##RIDGEPLOT w/ MEAN 

answers <- levels(df$MAKER_ID)
left <- rep(ref_labels['MAKER_DATA','left'],  length(levels(df$MAKER_ID)))
right <- rep(ref_labels['MAKER_DATA','right'],  length(levels(df$MAKER_ID)))

df %>% 
  group_by(MAKER_ID) %>% 
  mutate(count = n()) %>% 
  ggplot(aes(y = fct_rev(MAKER_ID), x= MAKER_DATA, fill = fct_rev(MAKER_ID))) + 
  scale_x_continuous(limits = c(0,100))+
  geom_density_ridges(scale = 0.55,quantile_lines = TRUE, alpha = 0.75) + 
  stat_pointinterval(side = "bottom", scale = 0.7, slab_linewidth = NA, point_interval = "mean_qi") +
  stat_summary(fun=mean, geom="text", colour="blue",  fontface = "bold", 
               vjust=+2, hjust = 0, aes( label=round(..x.., digits=0)))+
  stat_summary(fun="mean", geom="point", shape=20, size=5, color="blue", fill="blue") +
  scale_fill_manual(values = my_palettes(name="reds", direction = "-1"), name = "",  guide = guide_legend(reverse = TRUE)) +   
  guides(
      y = guide_axis_manual(labels = left, title = ""),
      y.sec = guide_axis_manual(labels = right)
    ) +
  geom_text(aes(label= paste0("n=",count) ,  y = MAKER_ID, x = 100), color = "black",size = 3, nudge_y = 0.25) + 
  cowplot::draw_text(text = toupper(answers), x = 0, y= answers, size = 10, vjust=-2, hjust=0) + 
  labs (title = "DATA COMPETENCY by MAKER ID", y = "", x = "MAKER DATA COMPETENCY", caption="(mean in blue)") +
  theme_minimal() + easy_remove_legend()
## Picking joint bandwidth of 7.9

2.12.1.1 (YES) model

### LINEAR MIXED EFFECTS MODEL ##################

df <- df_graphs 

## SET CONTRASTS
contrasts(df$MAKER_ID) <-car::contr.Treatment(levels(df$MAKER_ID)) # intercept first group mean; coeff dif from first

## DEFINE MODEL
f <- "MAKER_DATA ~ MAKER_ID + (1|PID) + (1|STIMULUS)"
m1 <-lmer(MAKER_DATA ~ MAKER_ID + (1|PID) + (1|STIMULUS), data=df)

## PRINT MODEL 
(m_eq <- extract_eq(m1, use_coef = TRUE, ital_vars = TRUE, coef_digits = 1, wrap = TRUE, intercept = "beta"))

\[ \begin{aligned} \widehat{MAKER\_DATA}_{i} &\sim N \left(54.3_{\alpha_{j[i],k[i]}}, \sigma^2 \right) \\ \alpha_{j} &\sim N \left(-8_{\gamma_{1}^{\alpha}}(MAKER\_ID_{[T.organization]}) - 20.1_{\gamma_{2}^{\alpha}}(MAKER\_ID_{[T.education]}) - 13.5_{\gamma_{3}^{\alpha}}(MAKER\_ID_{[T.business]}) - 13.7_{\gamma_{4}^{\alpha}}(MAKER\_ID_{[T.news]}) - 16.4_{\gamma_{5}^{\alpha}}(MAKER\_ID_{[T.political]}), 9 \right) \text{, for PID j = 1,} \dots \text{,J} \\ \alpha_{k} &\sim N \left(0, 11.5 \right) \text{, for STIMULUS k = 1,} \dots \text{,K} \end{aligned} \]

## DESCRIBE MODEL
summary(m1)
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: MAKER_DATA ~ MAKER_ID + (1 | PID) + (1 | STIMULUS)
##    Data: df
## 
## REML criterion at convergence: 14572.2
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -2.7463 -0.6693 -0.0982  0.6322  3.2701 
## 
## Random effects:
##  Groups   Name        Variance Std.Dev.
##  PID      (Intercept)  80.33    8.963  
##  STIMULUS (Intercept) 131.58   11.471  
##  Residual             482.62   21.969  
## Number of obs: 1590, groups:  PID, 318; STIMULUS, 25
## 
## Fixed effects:
##                          Estimate Std. Error       df t value
## (Intercept)                54.340      3.023   60.428  17.976
## MAKER_ID[T.organization]   -7.970      2.878 1523.019  -2.770
## MAKER_ID[T.education]     -20.131      2.180 1504.192  -9.236
## MAKER_ID[T.business]      -13.458      2.294 1538.056  -5.866
## MAKER_ID[T.news]          -13.679      2.370 1527.078  -5.771
## MAKER_ID[T.political]     -16.415      2.484 1546.715  -6.607
##                                      Pr(>|t|)    
## (Intercept)              < 0.0000000000000002 ***
## MAKER_ID[T.organization]              0.00567 ** 
## MAKER_ID[T.education]    < 0.0000000000000002 ***
## MAKER_ID[T.business]          0.0000000054420 ***
## MAKER_ID[T.news]              0.0000000095283 ***
## MAKER_ID[T.political]         0.0000000000537 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##               (Intr) MAKER_ID[T.r] MAKER_ID[T.d] MAKER_ID[T.b] MAKER_ID[T.n]
## MAKER_ID[T.r] -0.381                                                        
## MAKER_ID[T.d] -0.527  0.509                                                 
## MAKER_ID[T.b] -0.513  0.491         0.697                                   
## MAKER_ID[T.n] -0.518  0.500         0.678         0.658                     
## MAKER_ID[T.p] -0.498  0.478         0.639         0.619         0.652
anova(m1)
## Type III Analysis of Variance Table with Satterthwaite's method
##          Sum Sq Mean Sq NumDF  DenDF F value                Pr(>F)    
## MAKER_ID  45061  9012.2     5 1493.3  18.673 < 0.00000000000000022 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
performance(m1)
## # Indices of model performance
## 
## AIC       |      AICc |       BIC | R2 (cond.) | R2 (marg.) |   ICC |   RMSE |  Sigma
## -------------------------------------------------------------------------------------
## 14590.159 | 14590.273 | 14638.503 |      0.340 |      0.051 | 0.305 | 20.756 | 21.969
report(m1)
## We fitted a linear mixed model (estimated using REML and nloptwrap optimizer)
## to predict MAKER_DATA with MAKER_ID (formula: MAKER_DATA ~ MAKER_ID). The model
## included PID as random effects (formula: list(~1 | PID, ~1 | STIMULUS)). The
## model's total explanatory power is substantial (conditional R2 = 0.34) and the
## part related to the fixed effects alone (marginal R2) is of 0.05. The model's
## intercept, corresponding to MAKER_ID = individual, is at 54.34 (95% CI [48.41,
## 60.27], t(1581) = 17.98, p < .001). Within this model:
## 
##   - The effect of MAKER ID[T.organization] is statistically significant and
## negative (beta = -7.97, 95% CI [-13.61, -2.33], t(1581) = -2.77, p = 0.006;
## Std. beta = -0.29, 95% CI [-0.49, -0.08])
##   - The effect of MAKER ID[T.education] is statistically significant and negative
## (beta = -20.13, 95% CI [-24.41, -15.86], t(1581) = -9.24, p < .001; Std. beta =
## -0.73, 95% CI [-0.88, -0.57])
##   - The effect of MAKER ID[T.business] is statistically significant and negative
## (beta = -13.46, 95% CI [-17.96, -8.96], t(1581) = -5.87, p < .001; Std. beta =
## -0.49, 95% CI [-0.65, -0.32])
##   - The effect of MAKER ID[T.news] is statistically significant and negative
## (beta = -13.68, 95% CI [-18.33, -9.03], t(1581) = -5.77, p < .001; Std. beta =
## -0.49, 95% CI [-0.66, -0.33])
##   - The effect of MAKER ID[T.political] is statistically significant and negative
## (beta = -16.41, 95% CI [-21.29, -11.54], t(1581) = -6.61, p < .001; Std. beta =
## -0.59, 95% CI [-0.77, -0.42])
## 
## Standardized parameters were obtained by fitting the model on a standardized
## version of the dataset. 95% Confidence Intervals (CIs) and p-values were
## computed using a Wald t-distribution approximation.
## PLOT MODEL COEFFICIENTS
coefs <- model_parameters(m1)
plot_model(m1, type = "est",
        show.intercept = TRUE,
        show.values = TRUE,
        value.offset = .25,
        show.p = TRUE
) + theme_minimal() + labs(caption=f)

## PLOT MODEL PREDICTIONS
means <- estimate_means(m1, at = c("MAKER_ID"))

# sjPlot::plot_model(m1, type = "pred", terms = c("MAKER_ID")) +
#     theme_minimal() + labs(caption=f)

# plot(means) + theme_minimal() + labs(caption=f) +
# geom_text(aes(x=means$MAKER_ID, y=means$Mean, label=round(means$Mean,1)), 
#           color="blue", position = position_nudge(x=0.25)) 


## PLOT MODEL PREDICTIONS with CONTRASTS

## contrasts
# black = estimated means and CI range; grey = CI range of the difference (as compared to the point estimate).  
(contrasts <- estimate_contrasts(m1, contrast="MAKER_ID", method="pairwise"))
## Marginal Contrasts Analysis
## 
## Level1       |       Level2 | Difference |          95% CI |   SE |      df |     t |      p
## --------------------------------------------------------------------------------------------
## business     |         news |       0.22 | [ -5.47,  5.91] | 1.93 | 1477.69 |  0.11 | 0.909 
## business     |    political |       2.96 | [ -3.21,  9.12] | 2.10 | 1493.91 |  1.41 | 0.476 
## education    |     business |      -6.67 | [-11.80, -1.54] | 1.75 | 1450.53 | -3.82 | 0.001 
## education    |         news |      -6.45 | [-11.85, -1.05] | 1.84 | 1457.70 | -3.51 | 0.004 
## education    |    political |      -3.72 | [ -9.61,  2.18] | 2.01 | 1503.73 | -1.85 | 0.256 
## individual   |     business |      13.46 | [  6.70, 20.22] | 2.30 | 1538.67 |  5.85 | < .001
## individual   |    education |      20.13 | [ 13.71, 26.55] | 2.18 | 1505.25 |  9.22 | < .001
## individual   |         news |      13.68 | [  6.70, 20.66] | 2.38 | 1527.70 |  5.76 | < .001
## individual   | organization |       7.97 | [ -0.50, 16.44] | 2.88 | 1524.06 |  2.77 | 0.040 
## individual   |    political |      16.41 | [  9.09, 23.73] | 2.49 | 1547.12 |  6.59 | < .001
## news         |    political |       2.74 | [ -3.23,  8.71] | 2.03 | 1487.65 |  1.35 | 0.476 
## organization |     business |       5.49 | [ -2.34, 13.31] | 2.66 | 1508.62 |  2.06 | 0.197 
## organization |    education |      12.16 | [  4.57, 19.75] | 2.58 | 1508.15 |  4.71 | < .001
## organization |         news |       5.71 | [ -2.12, 13.54] | 2.66 | 1499.60 |  2.14 | 0.193 
## organization |    political |       8.44 | [  0.32, 16.57] | 2.76 | 1520.19 |  3.05 | 0.018 
## 
## Marginal contrasts estimated at MAKER_ID
## p-value adjustment method: Holm (1979)
plot(contrasts, means) + 
    geom_text(aes(x=means$MAKER_ID, y=means$Mean, label=round(means$Mean,1)), color="blue", position = position_nudge(x=0.25)) + 
  theme_minimal() + labs(caption = f)

2.12.2 Maker ID & Maker DESIGN COMPETENCY

df <- df_graphs

## Does MAKER_DESIGN  depend on MAKER ID?
##RIDGEPLOT w/ MEAN 

answers <- levels(df$MAKER_ID)
left <- rep(ref_labels['MAKER_DESIGN','left'],  length(levels(df$MAKER_ID)))
right <- rep(ref_labels['MAKER_DESIGN','right'],  length(levels(df$MAKER_ID)))

df %>% 
  group_by(MAKER_ID) %>% 
  mutate(count = n()) %>% 
  ggplot(aes(y = fct_rev(MAKER_ID), x= MAKER_DESIGN, fill = fct_rev(MAKER_ID))) + 
  scale_x_continuous(limits = c(0,100))+
  geom_density_ridges(scale = 0.55,quantile_lines = TRUE, alpha = 0.75) + 
  stat_pointinterval(side = "bottom", scale = 0.7, slab_linewidth = NA, point_interval = "mean_qi") +
  stat_summary(fun=mean, geom="text", colour="blue",  fontface = "bold", 
               vjust=+2, hjust = 0, aes( label=round(..x.., digits=0)))+
  stat_summary(fun="mean", geom="point", shape=20, size=5, color="blue", fill="blue") +
  scale_fill_manual(values = my_palettes(name="reds", direction = "-1"), name = "",  guide = guide_legend(reverse = TRUE)) +   
  guides(
      y = guide_axis_manual(labels = left, title = ""),
      y.sec = guide_axis_manual(labels = right)
    ) +
  geom_text(aes(label= paste0("n=",count) ,  y = MAKER_ID, x = 100), color = "black",size = 3, nudge_y = 0.25) + 
  cowplot::draw_text(text = toupper(answers), x = 0, y= answers, size = 10, vjust=-2, hjust=0) + 
  labs (title = "DESIGN COMPETENCY by MAKER ID", y = "", x = "MAKER DESIGN COMPETENCY", caption="(mean in blue)") +
  theme_minimal() + easy_remove_legend()
## Picking joint bandwidth of 8.17

2.12.2.1 (YES) model

### LINEAR MIXED EFFECTS MODEL ##################

df <- df_graphs 

## DEFINE MODEL
f <- "MAKER_DESIGN ~ MAKER_ID + (1|PID) + (1|STIMULUS)"
m1 <-lmer(MAKER_DESIGN ~ MAKER_ID + (1|PID) + (1|STIMULUS), data=df)

## PRINT MODEL 
(m_eq <- extract_eq(m1, use_coef = TRUE, ital_vars = TRUE, coef_digits = 1, wrap = TRUE, intercept = "beta"))

\[ \begin{aligned} \widehat{MAKER\_DESIGN}_{i} &\sim N \left(62.5_{\alpha_{j[i],k[i]}}, \sigma^2 \right) \\ \alpha_{j} &\sim N \left(-15.7_{\gamma_{1}^{\alpha}}(MAKER\_ID_{organization}) - 12.3_{\gamma_{2}^{\alpha}}(MAKER\_ID_{education}) - 15.7_{\gamma_{3}^{\alpha}}(MAKER\_ID_{business}) - 23.9_{\gamma_{4}^{\alpha}}(MAKER\_ID_{news}) - 20.2_{\gamma_{5}^{\alpha}}(MAKER\_ID_{political}), 8.3 \right) \text{, for PID j = 1,} \dots \text{,J} \\ \alpha_{k} &\sim N \left(0, 11.8 \right) \text{, for STIMULUS k = 1,} \dots \text{,K} \end{aligned} \]

## DESCRIBE MODEL
summary(m1)
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: MAKER_DESIGN ~ MAKER_ID + (1 | PID) + (1 | STIMULUS)
##    Data: df
## 
## REML criterion at convergence: 14710.7
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -3.2704 -0.6818 -0.0276  0.6768  2.5092 
## 
## Random effects:
##  Groups   Name        Variance Std.Dev.
##  PID      (Intercept)  68.24    8.261  
##  STIMULUS (Intercept) 139.11   11.794  
##  Residual             539.31   23.223  
## Number of obs: 1590, groups:  PID, 318; STIMULUS, 25
## 
## Fixed effects:
##                      Estimate Std. Error       df t value             Pr(>|t|)
## (Intercept)            62.526      3.125   61.610  20.009 < 0.0000000000000002
## MAKER_IDorganization  -15.661      3.018 1539.762  -5.189   0.0000002390642451
## MAKER_IDeducation     -12.298      2.288 1522.194  -5.374   0.0000000888493856
## MAKER_IDbusiness      -15.683      2.405 1554.156  -6.520   0.0000000000946328
## MAKER_IDnews          -23.929      2.486 1543.471  -9.625 < 0.0000000000000002
## MAKER_IDpolitical     -20.195      2.603 1561.314  -7.757   0.0000000000000156
##                         
## (Intercept)          ***
## MAKER_IDorganization ***
## MAKER_IDeducation    ***
## MAKER_IDbusiness     ***
## MAKER_IDnews         ***
## MAKER_IDpolitical    ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr) MAKER_IDr MAKER_IDd MAKER_IDb MAKER_IDn
## MAKER_IDrgn -0.386                                        
## MAKER_IDdct -0.534  0.509                                 
## MAKER_IDbsn -0.519  0.490     0.696                       
## MAKER_IDnws -0.524  0.500     0.676     0.656             
## MAKER_IDplt -0.505  0.477     0.638     0.618     0.651
anova(m1)
## Type III Analysis of Variance Table with Satterthwaite's method
##          Sum Sq Mean Sq NumDF  DenDF F value                Pr(>F)    
## MAKER_ID  55394   11079     5 1510.8  20.542 < 0.00000000000000022 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
performance(m1)
## # Indices of model performance
## 
## AIC       |      AICc |       BIC | R2 (cond.) | R2 (marg.) |   ICC |   RMSE |  Sigma
## -------------------------------------------------------------------------------------
## 14728.725 | 14728.839 | 14777.069 |      0.323 |      0.063 | 0.278 | 22.104 | 23.223
report(m1)
## We fitted a linear mixed model (estimated using REML and nloptwrap optimizer)
## to predict MAKER_DESIGN with MAKER_ID (formula: MAKER_DESIGN ~ MAKER_ID). The
## model included PID as random effects (formula: list(~1 | PID, ~1 | STIMULUS)).
## The model's total explanatory power is substantial (conditional R2 = 0.32) and
## the part related to the fixed effects alone (marginal R2) is of 0.06. The
## model's intercept, corresponding to MAKER_ID = individual, is at 62.53 (95% CI
## [56.40, 68.65], t(1581) = 20.01, p < .001). Within this model:
## 
##   - The effect of MAKER ID [organization] is statistically significant and
## negative (beta = -15.66, 95% CI [-21.58, -9.74], t(1581) = -5.19, p < .001;
## Std. beta = -0.55, 95% CI [-0.76, -0.34])
##   - The effect of MAKER ID [education] is statistically significant and negative
## (beta = -12.30, 95% CI [-16.79, -7.81], t(1581) = -5.37, p < .001; Std. beta =
## -0.43, 95% CI [-0.59, -0.28])
##   - The effect of MAKER ID [business] is statistically significant and negative
## (beta = -15.68, 95% CI [-20.40, -10.96], t(1581) = -6.52, p < .001; Std. beta =
## -0.55, 95% CI [-0.72, -0.39])
##   - The effect of MAKER ID [news] is statistically significant and negative (beta
## = -23.93, 95% CI [-28.81, -19.05], t(1581) = -9.62, p < .001; Std. beta =
## -0.84, 95% CI [-1.02, -0.67])
##   - The effect of MAKER ID [political] is statistically significant and negative
## (beta = -20.19, 95% CI [-25.30, -15.09], t(1581) = -7.76, p < .001; Std. beta =
## -0.71, 95% CI [-0.89, -0.53])
## 
## Standardized parameters were obtained by fitting the model on a standardized
## version of the dataset. 95% Confidence Intervals (CIs) and p-values were
## computed using a Wald t-distribution approximation.
## PLOT MODEL COEFFICIENTS
coefs <- model_parameters(m1)
plot_model(m1, type = "est",
        show.intercept = TRUE,
        show.values = TRUE,
        show.p = TRUE
) + theme_minimal() + labs(caption=f)

## PLOT MODEL PREDICTIONS
means <- estimate_means(m1, at = c("MAKER_ID"))

# sjPlot::plot_model(m1, type = "pred", terms = c("MAKER_ID")) +
#     theme_minimal() + labs(caption=f)

# plot(means) + theme_minimal() + labs(caption=f) +
# geom_text(aes(x=means$MAKER_ID, y=means$Mean, label=round(means$Mean,1)), 
#           color="blue", position = position_nudge(x=0.25)) 


## PLOT MODEL PREDICTIONS with CONTRASTS

## contrasts
# black = estimated means and CI range; grey = CI range of the difference (as compared to the point estimate).  
(contrasts <- estimate_contrasts(m1, contrast="MAKER_ID", method="pairwise"))
## Marginal Contrasts Analysis
## 
## Level1       |       Level2 | Difference |          95% CI |   SE |      df |        t |      p
## -----------------------------------------------------------------------------------------------
## business     |         news |       8.25 | [  2.27, 14.22] | 2.03 | 1496.07 |     4.06 | < .001
## business     |    political |       4.51 | [ -1.96, 10.99] | 2.20 | 1512.04 |     2.05 | 0.244 
## education    |     business |       3.38 | [ -2.01,  8.78] | 1.84 | 1468.49 |     1.84 | 0.327 
## education    |         news |      11.63 | [  5.95, 17.31] | 1.93 | 1475.26 |     6.02 | < .001
## education    |    political |       7.90 | [  1.71, 14.09] | 2.11 | 1521.55 |     3.75 | 0.001 
## individual   |     business |      15.68 | [  8.60, 22.77] | 2.41 | 1554.59 |     6.51 | < .001
## individual   |    education |      12.30 | [  5.56, 19.04] | 2.29 | 1523.08 |     5.36 | < .001
## individual   |         news |      23.93 | [ 16.60, 31.26] | 2.49 | 1543.93 |     9.60 | < .001
## individual   | organization |      15.66 | [  6.78, 24.55] | 3.02 | 1540.54 |     5.18 | < .001
## individual   |    political |      20.19 | [ 12.52, 27.87] | 2.61 | 1561.56 |     7.74 | < .001
## news         |    political |      -3.73 | [-10.01,  2.54] | 2.13 | 1506.23 |    -1.75 | 0.327 
## organization |     business |       0.02 | [ -8.19,  8.23] | 2.79 | 1526.44 | 7.63e-03 | 0.994 
## organization |    education |      -3.36 | [-11.32,  4.60] | 2.71 | 1525.72 |    -1.24 | 0.429 
## organization |         news |       8.27 | [  0.05, 16.48] | 2.79 | 1517.53 |     2.96 | 0.022 
## organization |    political |       4.53 | [ -3.99, 13.06] | 2.90 | 1537.12 |     1.56 | 0.355 
## 
## Marginal contrasts estimated at MAKER_ID
## p-value adjustment method: Holm (1979)
plot(contrasts, means) + 
    geom_text(aes(x=means$MAKER_ID, y=means$Mean, label=round(means$Mean,1)), color="blue", position = position_nudge(x=0.25)) + 
  theme_minimal() + labs(caption = f)

  • maker_design, chart_like, chart_beauty for BOOMER vs. others

  • maker_data for gen Z vs others

  • maker-data for FEMALE

  • maker data for design-basic, interesting pattern

  • look closer at chart beauty

  • interesting pattern across values on chart intent

— no difference at ALL in maker data - interesting! - chart beauty very diff - chart intent intersting bimodal

2.12.3 Maker ID & Maker POLITICS

**Is there an association between MAKER ID and MAKER POLITICS? We hypothesize that when the MAKER ID is identified as POLITICAL, the MAKER POLITICS score will be more strongly associated with either ends of the semantic differential scale (ie. left leaning or right leaning). We expect this to not be the case with the other MAKER ID values.

To test this hypothesis, we will model MAKER_ID as a predictor of MAKER_POLITICS_ABS (the absolute value of the collapsed maker politics sd scale), where 0 = the midpoint of the original scale, and 50 = both the 0 and 100 pts of the original scale

df <- df_graphs_abs

## Does MAKER POLITICS depend on MAKER ID?
##RIDGEPLOT w/ MEAN 
answers <- levels(df$MAKER_ID)
left <- rep(ref_labels_abs['MAKER_POLITIC','left'],  length(levels(df$MAKER_ID)))
right <- rep(ref_labels_abs['MAKER_POLITIC','right'],  length(levels(df$MAKER_ID)))

df %>% 
  group_by(MAKER_ID) %>% 
  mutate(count = n()) %>% 
  ggplot(aes(y = fct_rev(MAKER_ID), x= MAKER_POLITIC, fill = fct_rev(MAKER_ID))) + 
  scale_x_continuous(limits = c(0,50))+
  geom_density_ridges(scale = 0.55,quantile_lines = TRUE, alpha = 0.75) + 
  stat_pointinterval(side = "bottom", scale = 0.7, slab_linewidth = NA, point_interval = "mean_qi") +
  stat_summary(fun=mean, geom="text", colour="blue",  fontface = "bold", 
               vjust=+2, hjust = 0, aes( label=round(..x.., digits=0)))+
  stat_summary(fun="mean", geom="point", shape=20, size=5, color="blue", fill="blue") +
  scale_fill_manual(values = my_palettes(name="reds", direction = "-1"), name = "",  guide = guide_legend(reverse = TRUE)) +   
  guides(
      y = guide_axis_manual(labels = left, title = ""),
      y.sec = guide_axis_manual(labels = right)
    ) +
  geom_text(aes(label= paste0("n=",count) ,  y = MAKER_ID, x = 50), color = "black",size = 3, nudge_y = 0.25) + 
  cowplot::draw_text(text = toupper(answers), x = 0, y= answers, size = 10, vjust=-2, hjust=0) + 
  labs (title = "POLITICS (absolute value) by MAKER ID", y = "", x = "MAKER POLITICS", caption="(mean in blue)") +
  theme_minimal() + easy_remove_legend()

Once the MAKER_POLITICS score has been collapsed to the SD scale, we see that our hypothesis is likely false, as the mean (absolute value) maker_politics scores are nearly the same for individual, organization and politics, with only news, education and business being slighly more neutral.

2.12.3.1 (NO) model

### LINEAR MIXED EFFECTS MODEL ##################

df <- df_graphs_abs

## DEFINE MODEL
f <- "MAKER_POLITIC ~ MAKER_ID + (1|PID) + (1|STIMULUS)"
m1 <-lmer(MAKER_POLITIC ~ MAKER_ID + (1|PID) + (1|STIMULUS), data=df)

## PRINT MODEL 
(m_eq <- extract_eq(m1, use_coef = TRUE, ital_vars = TRUE, coef_digits = 1, wrap = TRUE, intercept = "beta"))

\[ \begin{aligned} \widehat{MAKER\_POLITIC}_{i} &\sim N \left(13.5_{\alpha_{j[i],k[i]}}, \sigma^2 \right) \\ \alpha_{j} &\sim N \left(0.2_{\gamma_{1}^{\alpha}}(MAKER\_ID_{organization}) - 3.8_{\gamma_{2}^{\alpha}}(MAKER\_ID_{education}) - 1.6_{\gamma_{3}^{\alpha}}(MAKER\_ID_{business}) - 2.2_{\gamma_{4}^{\alpha}}(MAKER\_ID_{news}) - 0.6_{\gamma_{5}^{\alpha}}(MAKER\_ID_{political}), 7.1 \right) \text{, for PID j = 1,} \dots \text{,J} \\ \alpha_{k} &\sim N \left(0, 4.3 \right) \text{, for STIMULUS k = 1,} \dots \text{,K} \end{aligned} \]

## DESCRIBE MODEL
summary(m1)
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: MAKER_POLITIC ~ MAKER_ID + (1 | PID) + (1 | STIMULUS)
##    Data: df
## 
## REML criterion at convergence: 12415.2
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -2.7909 -0.6304 -0.1448  0.5097  3.5618 
## 
## Random effects:
##  Groups   Name        Variance Std.Dev.
##  PID      (Intercept)  50.43    7.102  
##  STIMULUS (Intercept)  18.61    4.314  
##  Residual             110.97   10.534  
## Number of obs: 1590, groups:  PID, 318; STIMULUS, 25
## 
## Fixed effects:
##                       Estimate Std. Error        df t value
## (Intercept)            13.5486     1.3324   98.2476  10.169
## MAKER_IDorganization    0.2037     1.4183 1441.9854   0.144
## MAKER_IDeducation      -3.8306     1.0675 1419.5318  -3.588
## MAKER_IDbusiness       -1.6098     1.1289 1446.1837  -1.426
## MAKER_IDnews           -2.1858     1.1633 1431.8305  -1.879
## MAKER_IDpolitical      -0.6456     1.2232 1448.0104  -0.528
##                                  Pr(>|t|)    
## (Intercept)          < 0.0000000000000002 ***
## MAKER_IDorganization             0.885800    
## MAKER_IDeducation                0.000344 ***
## MAKER_IDbusiness                 0.154079    
## MAKER_IDnews                     0.060448 .  
## MAKER_IDpolitical                0.597713    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr) MAKER_IDr MAKER_IDd MAKER_IDb MAKER_IDn
## MAKER_IDrgn -0.425                                        
## MAKER_IDdct -0.589  0.509                                 
## MAKER_IDbsn -0.574  0.493     0.701                       
## MAKER_IDnws -0.579  0.502     0.682     0.662             
## MAKER_IDplt -0.557  0.478     0.642     0.625     0.655
anova(m1)
## Type III Analysis of Variance Table with Satterthwaite's method
##          Sum Sq Mean Sq NumDF  DenDF F value    Pr(>F)    
## MAKER_ID 2462.2  492.43     5 1412.4  4.4377 0.0005147 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
performance(m1)
## # Indices of model performance
## 
## AIC       |      AICc |       BIC | R2 (cond.) | R2 (marg.) |   ICC |  RMSE |  Sigma
## ------------------------------------------------------------------------------------
## 12433.197 | 12433.311 | 12481.540 |      0.390 |      0.011 | 0.384 | 9.687 | 10.534
report(m1)
## We fitted a linear mixed model (estimated using REML and nloptwrap optimizer)
## to predict MAKER_POLITIC with MAKER_ID (formula: MAKER_POLITIC ~ MAKER_ID). The
## model included PID as random effects (formula: list(~1 | PID, ~1 | STIMULUS)).
## The model's total explanatory power is substantial (conditional R2 = 0.39) and
## the part related to the fixed effects alone (marginal R2) is of 0.01. The
## model's intercept, corresponding to MAKER_ID = individual, is at 13.55 (95% CI
## [10.94, 16.16], t(1581) = 10.17, p < .001). Within this model:
## 
##   - The effect of MAKER ID [organization] is statistically non-significant and
## positive (beta = 0.20, 95% CI [-2.58, 2.99], t(1581) = 0.14, p = 0.886; Std.
## beta = 0.01, 95% CI [-0.19, 0.22])
##   - The effect of MAKER ID [education] is statistically significant and negative
## (beta = -3.83, 95% CI [-5.92, -1.74], t(1581) = -3.59, p < .001; Std. beta =
## -0.28, 95% CI [-0.43, -0.13])
##   - The effect of MAKER ID [business] is statistically non-significant and
## negative (beta = -1.61, 95% CI [-3.82, 0.60], t(1581) = -1.43, p = 0.154; Std.
## beta = -0.12, 95% CI [-0.28, 0.04])
##   - The effect of MAKER ID [news] is statistically non-significant and negative
## (beta = -2.19, 95% CI [-4.47, 0.10], t(1581) = -1.88, p = 0.060; Std. beta =
## -0.16, 95% CI [-0.32, 6.97e-03])
##   - The effect of MAKER ID [political] is statistically non-significant and
## negative (beta = -0.65, 95% CI [-3.04, 1.75], t(1581) = -0.53, p = 0.598; Std.
## beta = -0.05, 95% CI [-0.22, 0.13])
## 
## Standardized parameters were obtained by fitting the model on a standardized
## version of the dataset. 95% Confidence Intervals (CIs) and p-values were
## computed using a Wald t-distribution approximation.
## PLOT MODEL COEFFICIENTS
coefs <- model_parameters(m1)
plot_model(m1, type = "est",
        show.intercept = TRUE,
        show.values = TRUE,
        show.p = TRUE
) + theme_minimal() + labs(caption=f)

## PLOT MODEL PREDICTIONS
means <- estimate_means(m1, at = c("MAKER_ID"))

# sjPlot::plot_model(m1, type = "pred", terms = c("MAKER_ID")) +
#     theme_minimal() + labs(caption=f)

# plot(means) + theme_minimal() + labs(caption=f) +
# geom_text(aes(x=means$MAKER_ID, y=means$Mean, label=round(means$Mean,1)), 
#           color="blue", position = position_nudge(x=0.25)) 


## PLOT MODEL PREDICTIONS with CONTRASTS

## contrasts
# black = estimated means and CI range; grey = CI range of the difference (as compared to the point estimate).  
(contrasts <- estimate_contrasts(m1, contrast="MAKER_ID", method="pairwise"))
## Marginal Contrasts Analysis
## 
## Level1       |       Level2 | Difference |         95% CI |   SE |      df |     t |      p
## -------------------------------------------------------------------------------------------
## business     |         news |       0.58 | [-2.20,  3.35] | 0.94 | 1401.87 |  0.61 | > .999
## business     |    political |      -0.96 | [-3.98,  2.05] | 1.02 | 1406.24 | -0.94 | > .999
## education    |     business |      -2.22 | [-4.73,  0.28] | 0.85 | 1379.01 | -2.61 | 0.111 
## education    |         news |      -1.64 | [-4.28,  0.99] | 0.90 | 1388.80 | -1.84 | 0.673 
## education    |    political |      -3.18 | [-6.07, -0.30] | 0.98 | 1416.16 | -3.25 | 0.017 
## individual   |     business |       1.61 | [-1.72,  4.94] | 1.13 | 1448.29 |  1.42 | > .999
## individual   |    education |       3.83 | [ 0.69,  6.98] | 1.07 | 1421.56 |  3.58 | 0.005 
## individual   |         news |       2.19 | [-1.24,  5.62] | 1.17 | 1434.73 |  1.87 | 0.673 
## individual   | organization |      -0.20 | [-4.38,  3.97] | 1.42 | 1442.00 | -0.14 | > .999
## individual   |    political |       0.65 | [-2.96,  4.25] | 1.23 | 1450.78 |  0.53 | > .999
## news         |    political |      -1.54 | [-4.46,  1.38] | 0.99 | 1409.69 | -1.55 | 0.972 
## organization |     business |       1.81 | [-2.03,  5.66] | 1.31 | 1426.41 |  1.39 | > .999
## organization |    education |       4.03 | [ 0.30,  7.77] | 1.27 | 1425.16 |  3.18 | 0.020 
## organization |         news |       2.39 | [-1.46,  6.24] | 1.31 | 1418.54 |  1.83 | 0.673 
## organization |    political |       0.85 | [-3.16,  4.85] | 1.36 | 1437.73 |  0.62 | > .999
## 
## Marginal contrasts estimated at MAKER_ID
## p-value adjustment method: Holm (1979)
plot(contrasts, means) + 
    geom_text(aes(x=means$MAKER_ID, y=means$Mean, label=round(means$Mean,1)), color="blue", position = position_nudge(x=0.25)) + 
  theme_minimal() + labs(caption = f)

The results of the model confirm our suspicion that our hypothesis is not supported by the data. MAKER_ID is not a strong predictor of MAKER_POLITICS (absolute value). Post-hoc contrasts demonstrate that the mean values of some levels are significantly different (e.g individual v. education, organization v. education, education v. political) however the overall model does not indicate a good fit.

2.12.4 Maker ID & Maker TRUST

**Do people indicate higher TRUST in artifacts they attribute to EDUCATION type makers?

df <- df_graphs

## Does MAKER_TRUST  depend on MAKER ID?
##RIDGEPLOT w/ MEAN 

answers <- levels(df$MAKER_ID)
left <- rep(ref_labels['MAKER_TRUST','left'],  length(levels(df$MAKER_ID)))
right <- rep(ref_labels['MAKER_TRUST','right'],  length(levels(df$MAKER_ID)))

df %>% 
  group_by(MAKER_ID) %>% 
  mutate(count = n()) %>% 
  ggplot(aes(y = fct_rev(MAKER_ID), x= MAKER_TRUST, fill = fct_rev(MAKER_ID))) + 
  scale_x_continuous(limits = c(0,100))+
  geom_density_ridges(scale = 0.55,quantile_lines = TRUE, alpha = 0.75) + 
  stat_pointinterval(side = "bottom", scale = 0.7, slab_linewidth = NA, point_interval = "mean_qi") +
  stat_summary(fun=mean, geom="text", colour="blue",  fontface = "bold", 
               vjust=+2, hjust = 0, aes( label=round(..x.., digits=0)))+
  stat_summary(fun="mean", geom="point", shape=20, size=5, color="blue", fill="blue") +
  scale_fill_manual(values = my_palettes(name="reds", direction = "-1"), name = "",  guide = guide_legend(reverse = TRUE)) +   
  guides(
      y = guide_axis_manual(labels = left, title = ""),
      y.sec = guide_axis_manual(labels = right)
    ) +
  geom_text(aes(label= paste0("n=",count) ,  y = MAKER_ID, x = 100), color = "black",size = 3, nudge_y = 0.25) + 
  cowplot::draw_text(text = toupper(answers), x = 0, y= answers, size = 10, vjust=-2, hjust=0) + 
  labs (title = "MAKER TRUST  by MAKER ID", y = "", x = "MAKER TRUST", caption="(mean in blue)") +
  theme_minimal() + easy_remove_legend()
## Picking joint bandwidth of 4.55

2.12.4.1 (YES) model

### LINEAR MIXED EFFECTS MODEL ##################

df <- df_graphs 

## DEFINE MODEL
f <- "MAKER_TRUST ~ MAKER_ID + (1|PID) + (1|STIMULUS)"
m1 <-lmer(MAKER_TRUST ~ MAKER_ID + (1|PID) + (1|STIMULUS), data=df)

## PRINT MODEL 
(m_eq <- extract_eq(m1, use_coef = TRUE, ital_vars = TRUE, coef_digits = 1, wrap = TRUE, intercept = "beta"))

\[ \begin{aligned} \widehat{MAKER\_TRUST}_{i} &\sim N \left(52.2_{\alpha_{j[i],k[i]}}, \sigma^2 \right) \\ \alpha_{j} &\sim N \left(5_{\gamma_{1}^{\alpha}}(MAKER\_ID_{organization}) + 11.7_{\gamma_{2}^{\alpha}}(MAKER\_ID_{education}) + 1.6_{\gamma_{3}^{\alpha}}(MAKER\_ID_{business}) + 6.4_{\gamma_{4}^{\alpha}}(MAKER\_ID_{news}) + 1.6_{\gamma_{5}^{\alpha}}(MAKER\_ID_{political}), 7.1 \right) \text{, for PID j = 1,} \dots \text{,J} \\ \alpha_{k} &\sim N \left(0, 5.5 \right) \text{, for STIMULUS k = 1,} \dots \text{,K} \end{aligned} \]

## DESCRIBE MODEL
summary(m1)
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: MAKER_TRUST ~ MAKER_ID + (1 | PID) + (1 | STIMULUS)
##    Data: df
## 
## REML criterion at convergence: 13527.9
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -3.4861 -0.5306 -0.0062  0.5833  2.7640 
## 
## Random effects:
##  Groups   Name        Variance Std.Dev.
##  PID      (Intercept)  49.79    7.056  
##  STIMULUS (Intercept)  30.35    5.509  
##  Residual             247.90   15.745  
## Number of obs: 1590, groups:  PID, 318; STIMULUS, 25
## 
## Fixed effects:
##                      Estimate Std. Error       df t value             Pr(>|t|)
## (Intercept)            52.232      1.795  108.126  29.106 < 0.0000000000000002
## MAKER_IDorganization    5.030      2.068 1518.206   2.432             0.015118
## MAKER_IDeducation      11.706      1.560 1484.176   7.506    0.000000000000105
## MAKER_IDbusiness        1.622      1.642 1512.352   0.988             0.323356
## MAKER_IDnews            6.375      1.693 1485.447   3.765             0.000173
## MAKER_IDpolitical       1.633      1.776 1503.328   0.919             0.358119
##                         
## (Intercept)          ***
## MAKER_IDorganization *  
## MAKER_IDeducation    ***
## MAKER_IDbusiness        
## MAKER_IDnews         ***
## MAKER_IDpolitical       
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr) MAKER_IDr MAKER_IDd MAKER_IDb MAKER_IDn
## MAKER_IDrgn -0.458                                        
## MAKER_IDdct -0.635  0.508                                 
## MAKER_IDbsn -0.617  0.490     0.695                       
## MAKER_IDnws -0.622  0.498     0.677     0.657             
## MAKER_IDplt -0.599  0.475     0.639     0.620     0.650
anova(m1)
## Type III Analysis of Variance Table with Satterthwaite's method
##          Sum Sq Mean Sq NumDF  DenDF F value                Pr(>F)    
## MAKER_ID  25811  5162.2     5 1476.7  20.824 < 0.00000000000000022 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
performance(m1)
## # Indices of model performance
## 
## AIC       |      AICc |       BIC | R2 (cond.) | R2 (marg.) |   ICC |   RMSE |  Sigma
## -------------------------------------------------------------------------------------
## 13545.852 | 13545.966 | 13594.195 |      0.285 |      0.054 | 0.244 | 14.807 | 15.745
report(m1)
## We fitted a linear mixed model (estimated using REML and nloptwrap optimizer)
## to predict MAKER_TRUST with MAKER_ID (formula: MAKER_TRUST ~ MAKER_ID). The
## model included PID as random effects (formula: list(~1 | PID, ~1 | STIMULUS)).
## The model's total explanatory power is substantial (conditional R2 = 0.29) and
## the part related to the fixed effects alone (marginal R2) is of 0.05. The
## model's intercept, corresponding to MAKER_ID = individual, is at 52.23 (95% CI
## [48.71, 55.75], t(1581) = 29.11, p < .001). Within this model:
## 
##   - The effect of MAKER ID [organization] is statistically significant and
## positive (beta = 5.03, 95% CI [0.97, 9.09], t(1581) = 2.43, p = 0.015; Std.
## beta = 0.27, 95% CI [0.05, 0.49])
##   - The effect of MAKER ID [education] is statistically significant and positive
## (beta = 11.71, 95% CI [8.65, 14.77], t(1581) = 7.51, p < .001; Std. beta =
## 0.63, 95% CI [0.46, 0.79])
##   - The effect of MAKER ID [business] is statistically non-significant and
## positive (beta = 1.62, 95% CI [-1.60, 4.84], t(1581) = 0.99, p = 0.323; Std.
## beta = 0.09, 95% CI [-0.09, 0.26])
##   - The effect of MAKER ID [news] is statistically significant and positive (beta
## = 6.38, 95% CI [3.05, 9.70], t(1581) = 3.76, p < .001; Std. beta = 0.34, 95% CI
## [0.16, 0.52])
##   - The effect of MAKER ID [political] is statistically non-significant and
## positive (beta = 1.63, 95% CI [-1.85, 5.12], t(1581) = 0.92, p = 0.358; Std.
## beta = 0.09, 95% CI [-0.10, 0.27])
## 
## Standardized parameters were obtained by fitting the model on a standardized
## version of the dataset. 95% Confidence Intervals (CIs) and p-values were
## computed using a Wald t-distribution approximation.
## PLOT MODEL COEFFICIENTS
coefs <- model_parameters(m1)
plot_model(m1, type = "est",
        show.intercept = TRUE,
        show.values = TRUE,
        show.p = TRUE
) + theme_minimal() + labs(caption=f)

## PLOT MODEL PREDICTIONS
means <- estimate_means(m1, at = c("MAKER_ID"))

# sjPlot::plot_model(m1, type = "pred", terms = c("MAKER_ID")) +
#     theme_minimal() + labs(caption=f)

# plot(means) + theme_minimal() + labs(caption=f) +
# geom_text(aes(x=means$MAKER_ID, y=means$Mean, label=round(means$Mean,1)), 
#           color="blue", position = position_nudge(x=0.25)) 


## PLOT MODEL PREDICTIONS with CONTRASTS

## contrasts
# black = estimated means and CI range; grey = CI range of the difference (as compared to the point estimate).  
(contrasts <- estimate_contrasts(m1, contrast="MAKER_ID", method="pairwise"))
## Marginal Contrasts Analysis
## 
## Level1       |       Level2 | Difference |          95% CI |   SE |      df |         t |      p
## ------------------------------------------------------------------------------------------------
## business     |         news |      -4.75 | [ -8.83, -0.68] | 1.39 | 1465.35 |     -3.43 | 0.006 
## business     |    political |      -0.01 | [ -4.42,  4.40] | 1.50 | 1460.93 | -6.82e-03 | > .999
## education    |     business |      10.08 | [  6.40, 13.77] | 1.25 | 1444.24 |      8.05 | < .001
## education    |         news |       5.33 | [  1.46,  9.20] | 1.32 | 1447.18 |      4.05 | < .001
## education    |    political |      10.07 | [  5.86, 14.29] | 1.43 | 1474.08 |      7.02 | < .001
## individual   |     business |      -1.62 | [ -6.46,  3.22] | 1.65 | 1513.27 |     -0.98 | > .999
## individual   |    education |     -11.71 | [-16.30, -7.11] | 1.56 | 1485.07 |     -7.49 | < .001
## individual   |         news |      -6.38 | [-11.37, -1.38] | 1.70 | 1487.04 |     -3.75 | 0.002 
## individual   | organization |      -5.03 | [-11.12,  1.06] | 2.07 | 1518.40 |     -2.43 | 0.107 
## individual   |    political |      -1.63 | [ -6.87,  3.61] | 1.78 | 1504.82 |     -0.92 | > .999
## news         |    political |       4.74 | [  0.46,  9.02] | 1.46 | 1479.72 |      3.26 | 0.009 
## organization |     business |       3.41 | [ -2.22,  9.03] | 1.91 | 1502.81 |      1.78 | 0.450 
## organization |    education |      -6.68 | [-12.13, -1.22] | 1.86 | 1501.53 |     -3.60 | 0.003 
## organization |         news |      -1.35 | [ -6.97,  4.28] | 1.91 | 1493.53 |     -0.70 | > .999
## organization |    political |       3.40 | [ -2.45,  9.24] | 1.99 | 1514.87 |      1.71 | 0.450 
## 
## Marginal contrasts estimated at MAKER_ID
## p-value adjustment method: Holm (1979)
plot(contrasts, means) + 
    geom_text(aes(x=means$MAKER_ID, y=means$Mean, label=round(means$Mean,1)), color="blue", position = position_nudge(x=0.25)) + 
  theme_minimal() + labs(caption = f)

3 STASH

wip code stash

3.1 half boxplot raincloud mean

# ## HALF BOXPLOT + DOTPLOT + MEAN
# ##############################
# H <-  df %>% 
#   group_by(MAKER_AGE) %>% 
#   mutate(count = n(), m = mean(MAKER_CONF)) %>% 
#   ggplot(aes(y = MAKER_CONF, x = fct_rev(MAKER_AGE), color = fct_rev(MAKER_AGE))) + 
#     geom_half_boxplot(side="r", alpha = 0.5, aes(fill=fct_rev(MAKER_AGE))) + 
#     stat_summary(fun=mean, geom="text", colour="blue",  fontface = "bold", 
#                vjust=-0.75, hjust = 1, aes( label=round(..y.., digits=0)))+
#     scale_color_manual(values = my_palettes(name="lightblues", direction = "-1"), 
#                        guide = guide_legend(reverse = TRUE)) + 
#     scale_fill_manual(values = my_palettes(name="lightblues", direction = "-1"), 
#                       guide = guide_legend(reverse = TRUE)) + 
#     stat_dotsinterval(side = "bottom", scale = 0.7, slab_linewidth = NA, 
#                         aes(fill = fct_rev(MAKER_AGE)) , color="black",  point_interval = "mean_qi")  +
#     stat_summary(fun="mean", geom="point", shape=20, size=5, color="blue", fill="blue") +
#     geom_text(aes(label= paste0("n=",count) ,  y = 5), color = "black",
#             size = 3, nudge_x=0.35) + 
#   labs(y="Maker Age Confidence", x="") + 
#   theme_minimal() + 
#   easy_remove_legend()+
#   coord_flip() 
# ##############################
#   

3.2 wip confidence modelling

# 
# ## [test-frame] Are the confidence scores significantly different for different questions?
# ## [model-frame] Does QUESTION predict CONFIDENCE, accounting for random variance in SUBJECT and STIMULUS?
# 
# 
# ## MIXED model with random variance only at subject (not stimulus)
# mm1 <- lmer( CONFIDENCE ~ QUESTION + (1|PID), data = df)
# # summary(mm1)
# # plot(check_model(mm1))
# # pm <- model_parameters(mm1)
# # plot(pm, show_labels = TRUE, show_intercept = TRUE) + labs(title = "CONFIDENCE ~ QUESTION + (1|PID)")
# # performance(mm1)
# # report(mm1)
# 
# 
# ## MIXED model with random variance only at subject AND stimulus
# mm2 <- lmer( CONFIDENCE ~ QUESTION + (1|PID) + (1|STIMULUS), data = df)
# # summary(mm2)
# # plot(check_model(mm2))
# # pm <- model_parameters(mm2)
# # plot_model(mm2)
# # plot(pm, show_labels = TRUE, show_intercept = TRUE) + labs(title = "CONFIDENCE ~ QUESTION + (1|PID) + (1|STIMULUS)")
# # performance(mm2)
# # report(mm2)
# 
# 
# ## MIXED model with random slope for question by person and random intercept by stimulus
# mm3 <- lmer( CONFIDENCE ~ QUESTION +  (1 + QUESTION | PID) + (1|STIMULUS), data = df)
# # summary(mm3)
# # plot(check_model(mm3))
# # pm <- model_parameters(mm3)
# # plot(pm, show_labels = TRUE, show_intercept = TRUE) + labs(title = "CONFIDENCE ~ QUESTION +   (1 + QUESTION | PID) + (1|STIMULUS)")
# # performance(mm3)
# # report(mm3)
# 
# 
# ## MIXED model with STIMULUS as FIXED effect and random intercept by person
# mm4 <- lmer( CONFIDENCE ~ QUESTION + STIMULUS +  (1 | PID), data = df)
# # summary(mm4)
# # plot(check_model(mm4))
# # pm <- model_parameters(mm4)
# # plot(pm, show_labels = TRUE, show_intercept = FALSE) + labs(title = "CONFIDENCE ~ QUESTION + STIMULUS +  (1 | PID)")
# # performance(mm4)
# # report(mm4)
# 
# ## MIXED model with STIMULUS * QUESTION interaction and random intercept by person
# mm5 <- lmer( CONFIDENCE ~ QUESTION * STIMULUS +  (1 | PID), data = df)
# # summary(mm5)
# # plot(check_model(mm5))
# # pm <- model_parameters(mm5)
# # plot(pm, show_labels = TRUE, show_intercept = FALSE) + labs(title = "CONFIDENCE ~ QUESTION * STIMULUS +  (1 | PID)")
# # performance(mm5)
# # report(mm5)
# 
# 
# ## MIXED model with STIMULUS * QUESTION interaction and random intercept by person
# mmx <- lmer( CONFIDENCE ~ STIMULUS  +  (1 | PID) + (1 | QUESTION), data = df)
# # summary(mmx)
# # plot(check_model(mmx))
# # pm <- model_parameters(mmx)
# # plot(pm, show_labels = TRUE, show_intercept = FALSE) + labs(title = "CONFIDENCE ~ STIMULUS  +  (1 | PID) + (1 | QUESTION)")
# # performance(mmx)
# # report(mmx)
# 
# 
# ### COMPARE MODELS
# # compare_parameters(mm1,mm2,mm3, mm4, mm5, mmx)
# compare_performance(mm1,mm2,mm3, mm4, mm5, mmx, rank = TRUE )
# ## model 3 is the best fit, and is appropriate to the design of the study
# summary(mm3)
# report(mm3)
# # plot_model(mm3, terms = c("QUESTION", "STIMULUS"), type = "diag")
# 
# # # ## repeated measures aov
# # print("Repeated Measures ANOVA")
# # ex1 <- aov(CONFIDENCE~QUESTION+Error(PID), data=df)
# # summary(ex1)
# # report(ex1)
# 

3.3 correlation plot code

# ## SHADED CIRCLES
# corrplot(m, method = 'circle', type = 'lower', 
#          order = 'AOE', diag = FALSE,
#          insig='blank',
#          tl.col = "black")
# 
# 
# ## SHADED NUMBERS
# corrplot(m,  order = 'AOE', method = "number", 
#          diag = FALSE, type = "lower",
#          insig='blank',
#          # insig = 'label_sig', sig.level = c(0.001, 0.01, 0.05),
#          addCoef.col = '#595D60',
#          tl.pos = "ld", tl.col = "#595D60")
#          
# 
# ## SHADED SQUARED + COEFFS
# corrplot(m,  order = 'AOE', method = "circle", 
#          diag = FALSE, type = "lower",
#          insig='blank', sig.level = 0.05,
#          # insig = 'label_sig', sig.level = c(0.001, 0.01, 0.05),
#          addCoef.col = '#595D60',
#          tl.pos = "ld", tl.col = "#595D60")
#          

3.4 flip some sds

############## SETUP FOR FLIPPING SCALES ON SOME QUESTIONS TO MAKE THEM MORE READABLE
ref_sd_reordered <- c("MAKER_DATA","MAKER_DESIGN", 
                    "CHART_BEAUTY", "CHART_LIKE", 
                    "MAKER_POLITIC","MAKER_ARGUE", "MAKER_SELF", "CHART_INTENT",
                    "MAKER_ALIGN","MAKER_TRUST",
                    "CHART_TRUST")

left_reordered <- c("layperson","layperson", 
                    "NOT at all","NOT at all",
                    "left-leaning",
                    "diplomatic",
                    "altruistic",
                    "inform",    
                    "DOES share", 
                    "untrustworthy",
                    "untrustworthy")
right_reordered <- c("professional","professional",
                     "very much", "very much",          
                     "right-leaning",
                     "confrontational",
                     "selfish", 
                     "persuade",
                     "does NOT share", 
                     "trustworthy",
                     "trusthworthy")

ref_labels_reordered <- as.data.frame(cbind(left_reordered,right_reordered))
rownames(ref_labels_reordered) <- ref_sd_questions

3.5 correlation matrix

## GGALLY correlation heatmap
# ggcorr(df,
#        label = TRUE,  geom = "tile",
#        nbreaks = 5, layout.exp = 2,   
#        # label_round = 2,
#        angle = -0, hjust = 0.8, vjust = 1, size = 2.5,
#        low = "#D88585",mid = "white", high= "#6DA0D6") +
#        easy_remove_legend() + 
#   labs(title = "Correlation between SD measures", subtitle = ("pairwise; Pearson correlations"))

3.6 ridgeplot with interval and mean

# ## Does MAKER_TRUST  depend on MAKER ID?
# ##RIDGEPLOT w/ MEAN 
# answers <- levels(df$MAKER_ID)
# left <- rep(ref_labels['MAKER_TRUST','left'],  length(levels(df$MAKER_ID)))
# right <- rep(ref_labels['MAKER_TRUST','right'],  length(levels(df$MAKER_ID)))
# df %>% ggplot(aes(y = fct_rev(MAKER_ID), x= MAKER_TRUST, fill = fct_rev(MAKER_ID))) + 
#   geom_density_ridges(scale = 0.55,quantile_lines = TRUE, alpha = 0.75) + 
#   stat_dotsinterval(side = "bottom", scale = 0.7, slab_linewidth = NA, point_interval = "mean_qi") +
#   stat_summary(fun=mean, geom="text", colour="blue",  fontface = "bold", 
#                vjust=+2, hjust = 0, aes( label=round(..x.., digits=0)))+
#     stat_summary(fun="mean", geom="point", shape=20, size=5, color="blue", fill="blue") +
#   scale_fill_manual(values = my_palettes(name="reds", direction = "-1"), name = "",  guide = guide_legend(reverse = TRUE)) +   
#     guides(
#       y = guide_axis_manual(labels = left, title = ""),
#       y.sec = guide_axis_manual(labels = right)
#     ) +
#    cowplot::draw_text(text = toupper(answers), x = 10, y= answers,size = 10, vjust=-2) + 
#   labs (title = "MAKER TRUST by MAKER ID", y = "", x = "MAKER TRUST", caption="(mean in blue)") +
#   theme_minimal() + easy_remove_legend()

3.7 lessR donuts

##good for seeing the color schemes 
# #### DEFINE SET 
# stimulus  = "B2-1"
# df <- df_graphs %>% filter(STIMULUS == stimulus)
# 
# #### GENERATE GRAPHS
# 
#   #MAKER_ID-DONUT
#   PieChart(MAKER_ID, data = df,
#          fill = "reds",
#          main = paste0(stimulus, " MAKER ID")) + theme_minimal()
# 
# 
# #MAKER_GENDER-DONUT
# PieChart(MAKER_GENDER, data = df,
#        fill = "blues",
#        main = paste0(stimulus, " MAKER GENDER")) + theme_minimal()
# 
# 
# #MAKER_AGE-DONUT
# PieChart(MAKER_AGE, data = df,
#        fill = "olives",
#        main = paste0(stimulus, " MAKER AGE")) + theme_minimal()
# 
#   #MAKER_AGE-DONUT
#   PieChart(MAKER_ID, data = df,
#          fill = "rusts",
#          main = paste0(stimulus, " MAKER AGE")) + theme_minimal()
#   
#   #MAKER_AGE-DONUT
#   PieChart(MAKER_ID, data = df,
#          fill = "olives",
#          main = paste0(stimulus, " MAKER AGE")) + theme_minimal()
#   
#   #MAKER_AGE-DONUT
#   PieChart(MAKER_ID, data = df,
#          fill = "greens",
#          main = paste0(stimulus, " MAKER AGE")) + theme_minimal()
#   
#   #MAKER_AGE-DONUT
#   PieChart(MAKER_ID, data = df,
#          fill = "emeralds",
#          main = paste0(stimulus, " MAKER AGE")) + theme_minimal()
#   
#   #MAKER_AGE-DONUT
#   PieChart(MAKER_ID, data = df,
#          fill = "turquoises",
#          main = paste0(stimulus, " MAKER AGE")) + theme_minimal()
#   
#   #MAKER_AGE-DONUT
#   PieChart(MAKER_ID, data = df,
#          fill = "aquas",
#          main = paste0(stimulus, " MAKER AGE")) + theme_minimal()
#   
#   #MAKER_AGE-MAKER_ID
#   PieChart(MAKER_ID, data = df,
#          fill = "purples",
#          main = paste0(stimulus, " MAKER AGE")) + theme_minimal()
#   
#   #MAKER_AGE-DONUT
#   PieChart(MAKER_ID, data = df,
#          fill = "magentas",
#          main = paste0(stimulus, " MAKER AGE")) + theme_minimal()
#   
#   #MAKER_AGE-DONUT
#   PieChart(MAKER_ID, data = df,
#          fill = "violets",
#          main = paste0(stimulus, " MAKER AGE")) + theme_minimal()
#   
#   #MAKER_AGE-DONUT
#   PieChart(MAKER_ID, data = df,
#          fill = "grays",
#          main = paste0(stimulus, " MAKER AGE")) + theme_minimal()
# "reds"    h   0
# "rusts"   h   30
# "browns"  h   60
# "olives"  h   90
# "greens"  h   120
# "emeralds"    h   150
# "turquoises"  h   180
# "aquas"   h   210
# "blues"   h   240
# "purples" h   270
# "violets" h   300
# "magentas"    h   330
# "grays"

3.8 ggplot donuts

#   df <- df_graphs %>% filter(STIMULUS== s)
# #### CATEGORICAL DONUT PLOTS
#   #subset data cols 
#   cols <- df %>% select( all_of(ref_cat_questions))
#   
#   ggplot( df, aes( x = STIMULUS, fill = MAKER_ID)) +
#   geom_bar( position = "stack", width=1) +
#   coord_radial(theta = "y", start = 0, inner.radius = 0.5, expand=FALSE) +
#   scale_fill_manual(values = my_palettes(name="reds", direction = "1"), name = "",  guide = guide_legend(reverse = FALSE)) +   
#   labs( title = paste0(s, " MAKER ID")) +
#   theme_minimal()
#   
#   

3.9 Alluvial Plots

## EXAMPLE ALLUVIAL PLOT USING GGALUVIAL  (instead of GGSANKEY)
# https://corybrunson.github.io/ggalluvial/articles/ggalluvial.html

# #FILTER FOR BLOCK 2 STIM AND RESHAPE FOR SANKEY
# ds <- df_graphs %>% 
#   filter(str_detect(STIMULUS, "B2")) %>% 
#   select(STIMULUS, MAKER_ID, PID) %>% 
#   mutate(
#     MAKER_ID = fct_relevel(MAKER_ID, 
#               c("business","education","individual", "news","organization", "political" ))
#   )
# 
# ds %>% 
#   ggplot(aes( x = STIMULUS,
#               stratum = MAKER_ID,
#               label = MAKER_ID,
#               alluvium = PID)) +
#       stat_alluvium(aes(fill = MAKER_ID),
#                     width = 0,
#                     alpha = 1,
#                     geom = "flow")+
#       geom_stratum(width = 0.2, aes(fill= MAKER_ID))+
#       # geom_text(stat = "stratum", size = 5, angle = 90)+
#       scale_fill_viridis(discrete=TRUE, option="viridis", drop = FALSE,
#                      alpha = 1) +
#       theme_minimal()